1 /* undo handling for GNU Emacs.
2 Copyright (C) 1990, 1993-1994, 2000-2015 Free Software Foundation,
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
27 /* The first time a command records something for undo.
28 it also allocates the undo-boundary object
29 which will be added to the list at the end of the command.
30 This ensures we can't run out of space while trying to make
32 static Lisp_Object pending_boundary
;
34 /* Record point as it was at beginning of this command (if necessary)
35 and prepare the undo info for recording a change.
36 /* Prepare the undo info for recording a change. */
40 /* Allocate a cons cell to be the undo boundary after this command. */
41 if (NILP (pending_boundary
))
42 pending_boundary
= Fcons (Qnil
, Qnil
);
44 if (MODIFF
<= SAVE_MODIFF
)
45 record_first_change ();
48 /* Record point as it was at beginning of this command.
49 PT is the position of point that will naturally occur as a result of the
50 undo record that will be added just after this command terminates. */
52 record_point (ptrdiff_t pt
)
54 /* Don't record position of pt when undo_inhibit_record_point holds. */
55 if (undo_inhibit_record_point
)
60 at_boundary
= ! CONSP (BVAR (current_buffer
, undo_list
))
61 || NILP (XCAR (BVAR (current_buffer
, undo_list
)));
65 /* If we are just after an undo boundary, and
66 point wasn't at start of deleted range, record where it was. */
68 bset_undo_list (current_buffer
,
69 Fcons (make_number (pt
),
70 BVAR (current_buffer
, undo_list
)));
74 /* Record an insertion that just happened or is about to happen,
75 for LENGTH characters at position BEG.
76 (It is possible to record an insertion before or after the fact
77 because we don't need to record the contents.) */
80 record_insert (ptrdiff_t beg
, ptrdiff_t length
)
82 Lisp_Object lbeg
, lend
;
84 if (EQ (BVAR (current_buffer
, undo_list
), Qt
))
89 /* If this is following another insertion and consecutive with it
90 in the buffer, combine the two. */
91 if (CONSP (BVAR (current_buffer
, undo_list
)))
94 elt
= XCAR (BVAR (current_buffer
, undo_list
));
96 && INTEGERP (XCAR (elt
))
97 && INTEGERP (XCDR (elt
))
98 && XINT (XCDR (elt
)) == beg
)
100 XSETCDR (elt
, make_number (beg
+ length
));
105 XSETFASTINT (lbeg
, beg
);
106 XSETINT (lend
, beg
+ length
);
107 bset_undo_list (current_buffer
,
108 Fcons (Fcons (lbeg
, lend
), BVAR (current_buffer
, undo_list
)));
111 /* Record the fact that markers in the region of FROM, TO are about to
112 be adjusted. This is done only when a marker points within text
113 being deleted, because that's the only case where an automatic
114 marker adjustment won't be inverted automatically by undoing the
115 buffer modification. */
118 record_marker_adjustments (ptrdiff_t from
, ptrdiff_t to
)
121 register struct Lisp_Marker
*m
;
122 register ptrdiff_t charpos
, adjustment
;
124 /* Allocate a cons cell to be the undo boundary after this command. */
125 if (NILP (pending_boundary
))
126 pending_boundary
= Fcons (Qnil
, Qnil
);
128 for (m
= BUF_MARKERS (current_buffer
); m
; m
= m
->next
)
130 charpos
= m
->charpos
;
131 eassert (charpos
<= Z
);
133 if (from
<= charpos
&& charpos
<= to
)
135 /* insertion_type nil markers will end up at the beginning of
136 the re-inserted text after undoing a deletion, and must be
137 adjusted to move them to the correct place.
139 insertion_type t markers will automatically move forward
140 upon re-inserting the deleted text, so we have to arrange
141 for them to move backward to the correct position. */
142 adjustment
= (m
->insertion_type
? to
: from
) - charpos
;
146 XSETMISC (marker
, m
);
149 Fcons (Fcons (marker
, make_number (adjustment
)),
150 BVAR (current_buffer
, undo_list
)));
156 /* Record that a deletion is about to take place, of the characters in
157 STRING, at location BEG. Optionally record adjustments for markers
158 in the region STRING occupies in the current buffer. */
160 record_delete (ptrdiff_t beg
, Lisp_Object string
, bool record_markers
)
164 if (EQ (BVAR (current_buffer
, undo_list
), Qt
))
167 if (point_before_last_command_or_undo
!= beg
&&
168 buffer_before_last_command_or_undo
== current_buffer
)
170 record_point (point_before_last_command_or_undo
);
173 if (PT
== beg
+ SCHARS (string
))
175 XSETINT (sbeg
, -beg
);
180 XSETFASTINT (sbeg
, beg
);
184 /* primitive-undo assumes marker adjustments are recorded
185 immediately before the deletion is recorded. See bug 16818
188 record_marker_adjustments (beg
, beg
+ SCHARS (string
));
192 Fcons (Fcons (string
, sbeg
), BVAR (current_buffer
, undo_list
)));
195 /* Record that a replacement is about to take place,
196 for LENGTH characters at location BEG.
197 The replacement must not change the number of characters. */
200 record_change (ptrdiff_t beg
, ptrdiff_t length
)
202 record_delete (beg
, make_buffer_string (beg
, beg
+ length
, true), false);
203 record_insert (beg
, length
);
206 /* Record that an unmodified buffer is about to be changed.
207 Record the file modification date so that when undoing this entry
208 we can tell whether it is obsolete because the file was saved again. */
211 record_first_change (void)
213 struct buffer
*base_buffer
= current_buffer
;
215 if (EQ (BVAR (current_buffer
, undo_list
), Qt
))
218 if (base_buffer
->base_buffer
)
219 base_buffer
= base_buffer
->base_buffer
;
221 bset_undo_list (current_buffer
,
222 Fcons (Fcons (Qt
, Fvisited_file_modtime ()),
223 BVAR (current_buffer
, undo_list
)));
226 /* Record a change in property PROP (whose old value was VAL)
227 for LENGTH characters starting at position BEG in BUFFER. */
230 record_property_change (ptrdiff_t beg
, ptrdiff_t length
,
231 Lisp_Object prop
, Lisp_Object value
,
234 Lisp_Object lbeg
, lend
, entry
;
235 struct buffer
*buf
= XBUFFER (buffer
);
237 if (EQ (BVAR (buf
, undo_list
), Qt
))
240 /* Allocate a cons cell to be the undo boundary after this command. */
241 if (NILP (pending_boundary
))
242 pending_boundary
= Fcons (Qnil
, Qnil
);
244 if (MODIFF
<= SAVE_MODIFF
)
245 record_first_change ();
248 XSETINT (lend
, beg
+ length
);
249 entry
= Fcons (Qnil
, Fcons (prop
, Fcons (value
, Fcons (lbeg
, lend
))));
250 bset_undo_list (current_buffer
,
251 Fcons (entry
, BVAR (current_buffer
, undo_list
)));
254 DEFUN ("undo-boundary", Fundo_boundary
, Sundo_boundary
, 0, 0, 0,
255 doc
: /* Mark a boundary between units of undo.
256 An undo command will stop at this point,
257 but another undo command will undo to the previous boundary. */)
261 if (EQ (BVAR (current_buffer
, undo_list
), Qt
))
263 tem
= Fcar (BVAR (current_buffer
, undo_list
));
266 /* One way or another, cons nil onto the front of the undo list. */
267 if (!NILP (pending_boundary
))
269 /* If we have preallocated the cons cell to use here,
271 XSETCDR (pending_boundary
, BVAR (current_buffer
, undo_list
));
272 bset_undo_list (current_buffer
, pending_boundary
);
273 pending_boundary
= Qnil
;
276 bset_undo_list (current_buffer
,
277 Fcons (Qnil
, BVAR (current_buffer
, undo_list
)));
280 Fset (Qundo_auto__last_boundary_cause
, Qexplicit
);
281 point_before_last_command_or_undo
= PT
;
282 buffer_before_last_command_or_undo
= current_buffer
;
287 /* At garbage collection time, make an undo list shorter at the end,
288 returning the truncated list. How this is done depends on the
289 variables undo-limit, undo-strong-limit and undo-outer-limit.
290 In some cases this works by calling undo-outer-limit-function. */
293 truncate_undo_list (struct buffer
*b
)
296 Lisp_Object prev
, next
, last_boundary
;
297 EMACS_INT size_so_far
= 0;
299 /* Make sure that calling undo-outer-limit-function
300 won't cause another GC. */
301 ptrdiff_t count
= inhibit_garbage_collection ();
303 /* Make the buffer current to get its local values of variables such
304 as undo_limit. Also so that Vundo_outer_limit_function can
305 tell which buffer to operate on. */
306 record_unwind_current_buffer ();
307 set_buffer_internal (b
);
309 list
= BVAR (b
, undo_list
);
313 last_boundary
= Qnil
;
315 /* If the first element is an undo boundary, skip past it. */
316 if (CONSP (next
) && NILP (XCAR (next
)))
318 /* Add in the space occupied by this element and its chain link. */
319 size_so_far
+= sizeof (struct Lisp_Cons
);
321 /* Advance to next element. */
326 /* Always preserve at least the most recent undo record
327 unless it is really horribly big.
329 Skip, skip, skip the undo, skip, skip, skip the undo,
330 Skip, skip, skip the undo, skip to the undo bound'ry. */
332 while (CONSP (next
) && ! NILP (XCAR (next
)))
337 /* Add in the space occupied by this element and its chain link. */
338 size_so_far
+= sizeof (struct Lisp_Cons
);
341 size_so_far
+= sizeof (struct Lisp_Cons
);
342 if (STRINGP (XCAR (elt
)))
343 size_so_far
+= (sizeof (struct Lisp_String
) - 1
344 + SCHARS (XCAR (elt
)));
347 /* Advance to next element. */
352 /* If by the first boundary we have already passed undo_outer_limit,
353 we're heading for memory full, so offer to clear out the list. */
354 if (INTEGERP (Vundo_outer_limit
)
355 && size_so_far
> XINT (Vundo_outer_limit
)
356 && !NILP (Vundo_outer_limit_function
))
360 /* Normally the function this calls is undo-outer-limit-truncate. */
361 tem
= call1 (Vundo_outer_limit_function
, make_number (size_so_far
));
364 /* The function is responsible for making
365 any desired changes in buffer-undo-list. */
366 unbind_to (count
, Qnil
);
372 last_boundary
= prev
;
374 /* Keep additional undo data, if it fits in the limits. */
380 /* When we get to a boundary, decide whether to truncate
381 either before or after it. The lower threshold, undo_limit,
382 tells us to truncate after it. If its size pushes past
383 the higher threshold undo_strong_limit, we truncate before it. */
386 if (size_so_far
> undo_strong_limit
)
388 last_boundary
= prev
;
389 if (size_so_far
> undo_limit
)
393 /* Add in the space occupied by this element and its chain link. */
394 size_so_far
+= sizeof (struct Lisp_Cons
);
397 size_so_far
+= sizeof (struct Lisp_Cons
);
398 if (STRINGP (XCAR (elt
)))
399 size_so_far
+= (sizeof (struct Lisp_String
) - 1
400 + SCHARS (XCAR (elt
)));
403 /* Advance to next element. */
408 /* If we scanned the whole list, it is short enough; don't change it. */
411 /* Truncate at the boundary where we decided to truncate. */
412 else if (!NILP (last_boundary
))
413 XSETCDR (last_boundary
, Qnil
);
414 /* There's nothing we decided to keep, so clear it out. */
416 bset_undo_list (b
, Qnil
);
418 unbind_to (count
, Qnil
);
425 DEFSYM (Qinhibit_read_only
, "inhibit-read-only");
426 DEFSYM (Qundo_auto__last_boundary_cause
, "undo-auto--last-boundary-cause");
427 DEFSYM (Qexplicit
, "explicit");
429 /* Marker for function call undo list elements. */
430 DEFSYM (Qapply
, "apply");
432 pending_boundary
= Qnil
;
433 staticpro (&pending_boundary
);
435 defsubr (&Sundo_boundary
);
437 DEFVAR_INT ("undo-limit", undo_limit
,
438 doc
: /* Keep no more undo information once it exceeds this size.
439 This limit is applied when garbage collection happens.
440 When a previous command increases the total undo list size past this
441 value, the earlier commands that came before it are forgotten.
443 The size is counted as the number of bytes occupied,
444 which includes both saved text and other data. */);
447 DEFVAR_INT ("undo-strong-limit", undo_strong_limit
,
448 doc
: /* Don't keep more than this much size of undo information.
449 This limit is applied when garbage collection happens.
450 When a previous command increases the total undo list size past this
451 value, that command and the earlier commands that came before it are forgotten.
452 However, the most recent buffer-modifying command's undo info
453 is never discarded for this reason.
455 The size is counted as the number of bytes occupied,
456 which includes both saved text and other data. */);
457 undo_strong_limit
= 120000;
459 DEFVAR_LISP ("undo-outer-limit", Vundo_outer_limit
,
460 doc
: /* Outer limit on size of undo information for one command.
461 At garbage collection time, if the current command has produced
462 more than this much undo information, it discards the info and displays
463 a warning. This is a last-ditch limit to prevent memory overflow.
465 The size is counted as the number of bytes occupied, which includes
466 both saved text and other data. A value of nil means no limit. In
467 this case, accumulating one huge undo entry could make Emacs crash as
468 a result of memory overflow.
470 In fact, this calls the function which is the value of
471 `undo-outer-limit-function' with one argument, the size.
472 The text above describes the behavior of the function
473 that variable usually specifies. */);
474 Vundo_outer_limit
= make_number (12000000);
476 DEFVAR_LISP ("undo-outer-limit-function", Vundo_outer_limit_function
,
477 doc
: /* Function to call when an undo list exceeds `undo-outer-limit'.
478 This function is called with one argument, the current undo list size
479 for the most recent command (since the last undo boundary).
480 If the function returns t, that means truncation has been fully handled.
481 If it returns nil, the other forms of truncation are done.
483 Garbage collection is inhibited around the call to this function,
484 so it must make sure not to do a lot of consing. */);
485 Vundo_outer_limit_function
= Qnil
;
487 DEFVAR_BOOL ("undo-inhibit-record-point", undo_inhibit_record_point
,
488 doc
: /* Non-nil means do not record `point' in `buffer-undo-list'. */);
489 undo_inhibit_record_point
= false;