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/>. */
26 /* Position of point last time we inserted a boundary. */
27 static struct buffer
*last_boundary_buffer
;
28 static ptrdiff_t last_boundary_position
;
30 /* The first time a command records something for undo.
31 it also allocates the undo-boundary object
32 which will be added to the list at the end of the command.
33 This ensures we can't run out of space while trying to make
35 static Lisp_Object pending_boundary
;
37 /* Record point as it was at beginning of this command (if necessary)
38 and prepare the undo info for recording a change.
39 PT is the position of point that will naturally occur as a result of the
40 undo record that will be added just after this command terminates. */
43 record_point (ptrdiff_t pt
)
47 /* Don't record position of pt when undo_inhibit_record_point holds. */
48 if (undo_inhibit_record_point
)
51 /* Allocate a cons cell to be the undo boundary after this command. */
52 if (NILP (pending_boundary
))
53 pending_boundary
= Fcons (Qnil
, Qnil
);
55 at_boundary
= ! CONSP (BVAR (current_buffer
, undo_list
))
56 || NILP (XCAR (BVAR (current_buffer
, undo_list
)));
58 if (MODIFF
<= SAVE_MODIFF
)
59 record_first_change ();
61 /* If we are just after an undo boundary, and
62 point wasn't at start of deleted range, record where it was. */
64 && current_buffer
== last_boundary_buffer
65 && last_boundary_position
!= pt
)
66 bset_undo_list (current_buffer
,
67 Fcons (make_number (last_boundary_position
),
68 BVAR (current_buffer
, undo_list
)));
71 /* Record an insertion that just happened or is about to happen,
72 for LENGTH characters at position BEG.
73 (It is possible to record an insertion before or after the fact
74 because we don't need to record the contents.) */
77 record_insert (ptrdiff_t beg
, ptrdiff_t length
)
79 Lisp_Object lbeg
, lend
;
81 if (EQ (BVAR (current_buffer
, undo_list
), Qt
))
86 /* If this is following another insertion and consecutive with it
87 in the buffer, combine the two. */
88 if (CONSP (BVAR (current_buffer
, undo_list
)))
91 elt
= XCAR (BVAR (current_buffer
, undo_list
));
93 && INTEGERP (XCAR (elt
))
94 && INTEGERP (XCDR (elt
))
95 && XINT (XCDR (elt
)) == beg
)
97 XSETCDR (elt
, make_number (beg
+ length
));
102 XSETFASTINT (lbeg
, beg
);
103 XSETINT (lend
, beg
+ length
);
104 bset_undo_list (current_buffer
,
105 Fcons (Fcons (lbeg
, lend
), BVAR (current_buffer
, undo_list
)));
108 /* Record the fact that markers in the region of FROM, TO are about to
109 be adjusted. This is done only when a marker points within text
110 being deleted, because that's the only case where an automatic
111 marker adjustment won't be inverted automatically by undoing the
112 buffer modification. */
115 record_marker_adjustments (ptrdiff_t from
, ptrdiff_t to
)
118 register struct Lisp_Marker
*m
;
119 register ptrdiff_t charpos
, adjustment
;
121 /* Allocate a cons cell to be the undo boundary after this command. */
122 if (NILP (pending_boundary
))
123 pending_boundary
= Fcons (Qnil
, Qnil
);
125 for (m
= BUF_MARKERS (current_buffer
); m
; m
= m
->next
)
127 charpos
= m
->charpos
;
128 eassert (charpos
<= Z
);
130 if (from
<= charpos
&& charpos
<= to
)
132 /* insertion_type nil markers will end up at the beginning of
133 the re-inserted text after undoing a deletion, and must be
134 adjusted to move them to the correct place.
136 insertion_type t markers will automatically move forward
137 upon re-inserting the deleted text, so we have to arrange
138 for them to move backward to the correct position. */
139 adjustment
= (m
->insertion_type
? to
: from
) - charpos
;
143 XSETMISC (marker
, m
);
146 Fcons (Fcons (marker
, make_number (adjustment
)),
147 BVAR (current_buffer
, undo_list
)));
153 /* Record that a deletion is about to take place, of the characters in
154 STRING, at location BEG. Optionally record adjustments for markers
155 in the region STRING occupies in the current buffer. */
158 record_delete (ptrdiff_t beg
, Lisp_Object string
, bool record_markers
)
162 if (EQ (BVAR (current_buffer
, undo_list
), Qt
))
165 if (PT
== beg
+ SCHARS (string
))
167 XSETINT (sbeg
, -beg
);
172 XSETFASTINT (sbeg
, beg
);
176 /* primitive-undo assumes marker adjustments are recorded
177 immediately before the deletion is recorded. See bug 16818
180 record_marker_adjustments (beg
, beg
+ SCHARS (string
));
184 Fcons (Fcons (string
, sbeg
), BVAR (current_buffer
, undo_list
)));
187 /* Record that a replacement is about to take place,
188 for LENGTH characters at location BEG.
189 The replacement must not change the number of characters. */
192 record_change (ptrdiff_t beg
, ptrdiff_t length
)
194 record_delete (beg
, make_buffer_string (beg
, beg
+ length
, true), false);
195 record_insert (beg
, length
);
198 /* Record that an unmodified buffer is about to be changed.
199 Record the file modification date so that when undoing this entry
200 we can tell whether it is obsolete because the file was saved again. */
203 record_first_change (void)
205 struct buffer
*base_buffer
= current_buffer
;
207 if (EQ (BVAR (current_buffer
, undo_list
), Qt
))
210 if (base_buffer
->base_buffer
)
211 base_buffer
= base_buffer
->base_buffer
;
213 bset_undo_list (current_buffer
,
214 Fcons (Fcons (Qt
, Fvisited_file_modtime ()),
215 BVAR (current_buffer
, undo_list
)));
218 /* Record a change in property PROP (whose old value was VAL)
219 for LENGTH characters starting at position BEG in BUFFER. */
222 record_property_change (ptrdiff_t beg
, ptrdiff_t length
,
223 Lisp_Object prop
, Lisp_Object value
,
226 Lisp_Object lbeg
, lend
, entry
;
227 struct buffer
*buf
= XBUFFER (buffer
);
229 if (EQ (BVAR (buf
, undo_list
), Qt
))
232 /* Allocate a cons cell to be the undo boundary after this command. */
233 if (NILP (pending_boundary
))
234 pending_boundary
= Fcons (Qnil
, Qnil
);
236 if (MODIFF
<= SAVE_MODIFF
)
237 record_first_change ();
240 XSETINT (lend
, beg
+ length
);
241 entry
= Fcons (Qnil
, Fcons (prop
, Fcons (value
, Fcons (lbeg
, lend
))));
242 bset_undo_list (current_buffer
,
243 Fcons (entry
, BVAR (current_buffer
, undo_list
)));
246 DEFUN ("undo-boundary", Fundo_boundary
, Sundo_boundary
, 0, 0, 0,
247 doc
: /* Mark a boundary between units of undo.
248 An undo command will stop at this point,
249 but another undo command will undo to the previous boundary. */)
253 if (EQ (BVAR (current_buffer
, undo_list
), Qt
))
255 tem
= Fcar (BVAR (current_buffer
, undo_list
));
258 /* One way or another, cons nil onto the front of the undo list. */
259 if (!NILP (pending_boundary
))
261 /* If we have preallocated the cons cell to use here,
263 XSETCDR (pending_boundary
, BVAR (current_buffer
, undo_list
));
264 bset_undo_list (current_buffer
, pending_boundary
);
265 pending_boundary
= Qnil
;
268 bset_undo_list (current_buffer
,
269 Fcons (Qnil
, BVAR (current_buffer
, undo_list
)));
271 last_boundary_position
= PT
;
272 last_boundary_buffer
= current_buffer
;
274 Fset (Qundo_auto__last_boundary_cause
, Qexplicit
);
278 /* At garbage collection time, make an undo list shorter at the end,
279 returning the truncated list. How this is done depends on the
280 variables undo-limit, undo-strong-limit and undo-outer-limit.
281 In some cases this works by calling undo-outer-limit-function. */
284 truncate_undo_list (struct buffer
*b
)
287 Lisp_Object prev
, next
, last_boundary
;
288 EMACS_INT size_so_far
= 0;
290 /* Make sure that calling undo-outer-limit-function
291 won't cause another GC. */
292 ptrdiff_t count
= inhibit_garbage_collection ();
294 /* Make the buffer current to get its local values of variables such
295 as undo_limit. Also so that Vundo_outer_limit_function can
296 tell which buffer to operate on. */
297 record_unwind_current_buffer ();
298 set_buffer_internal (b
);
300 list
= BVAR (b
, undo_list
);
304 last_boundary
= Qnil
;
306 /* If the first element is an undo boundary, skip past it. */
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. */
317 /* Always preserve at least the most recent undo record
318 unless it is really horribly big.
320 Skip, skip, skip the undo, skip, skip, skip the undo,
321 Skip, skip, skip the undo, skip to the undo bound'ry. */
323 while (CONSP (next
) && ! NILP (XCAR (next
)))
328 /* Add in the space occupied by this element and its chain link. */
329 size_so_far
+= sizeof (struct Lisp_Cons
);
332 size_so_far
+= sizeof (struct Lisp_Cons
);
333 if (STRINGP (XCAR (elt
)))
334 size_so_far
+= (sizeof (struct Lisp_String
) - 1
335 + SCHARS (XCAR (elt
)));
338 /* Advance to next element. */
343 /* If by the first boundary we have already passed undo_outer_limit,
344 we're heading for memory full, so offer to clear out the list. */
345 if (INTEGERP (Vundo_outer_limit
)
346 && size_so_far
> XINT (Vundo_outer_limit
)
347 && !NILP (Vundo_outer_limit_function
))
351 /* Normally the function this calls is undo-outer-limit-truncate. */
352 tem
= call1 (Vundo_outer_limit_function
, make_number (size_so_far
));
355 /* The function is responsible for making
356 any desired changes in buffer-undo-list. */
357 unbind_to (count
, Qnil
);
363 last_boundary
= prev
;
365 /* Keep additional undo data, if it fits in the limits. */
371 /* When we get to a boundary, decide whether to truncate
372 either before or after it. The lower threshold, undo_limit,
373 tells us to truncate after it. If its size pushes past
374 the higher threshold undo_strong_limit, we truncate before it. */
377 if (size_so_far
> undo_strong_limit
)
379 last_boundary
= prev
;
380 if (size_so_far
> undo_limit
)
384 /* Add in the space occupied by this element and its chain link. */
385 size_so_far
+= sizeof (struct Lisp_Cons
);
388 size_so_far
+= sizeof (struct Lisp_Cons
);
389 if (STRINGP (XCAR (elt
)))
390 size_so_far
+= (sizeof (struct Lisp_String
) - 1
391 + SCHARS (XCAR (elt
)));
394 /* Advance to next element. */
399 /* If we scanned the whole list, it is short enough; don't change it. */
402 /* Truncate at the boundary where we decided to truncate. */
403 else if (!NILP (last_boundary
))
404 XSETCDR (last_boundary
, Qnil
);
405 /* There's nothing we decided to keep, so clear it out. */
407 bset_undo_list (b
, Qnil
);
409 unbind_to (count
, Qnil
);
416 DEFSYM (Qinhibit_read_only
, "inhibit-read-only");
417 DEFSYM (Qundo_auto__last_boundary_cause
, "undo-auto--last-boundary-cause");
418 DEFSYM (Qexplicit
, "explicit");
420 /* Marker for function call undo list elements. */
421 DEFSYM (Qapply
, "apply");
423 pending_boundary
= Qnil
;
424 staticpro (&pending_boundary
);
426 last_boundary_buffer
= NULL
;
428 defsubr (&Sundo_boundary
);
430 DEFVAR_INT ("undo-limit", undo_limit
,
431 doc
: /* Keep no more undo information once it exceeds this size.
432 This limit is applied when garbage collection happens.
433 When a previous command increases the total undo list size past this
434 value, the earlier commands that came before it are forgotten.
436 The size is counted as the number of bytes occupied,
437 which includes both saved text and other data. */);
440 DEFVAR_INT ("undo-strong-limit", undo_strong_limit
,
441 doc
: /* Don't keep more than this much size of undo information.
442 This limit is applied when garbage collection happens.
443 When a previous command increases the total undo list size past this
444 value, that command and the earlier commands that came before it are forgotten.
445 However, the most recent buffer-modifying command's undo info
446 is never discarded for this reason.
448 The size is counted as the number of bytes occupied,
449 which includes both saved text and other data. */);
450 undo_strong_limit
= 120000;
452 DEFVAR_LISP ("undo-outer-limit", Vundo_outer_limit
,
453 doc
: /* Outer limit on size of undo information for one command.
454 At garbage collection time, if the current command has produced
455 more than this much undo information, it discards the info and displays
456 a warning. This is a last-ditch limit to prevent memory overflow.
458 The size is counted as the number of bytes occupied, which includes
459 both saved text and other data. A value of nil means no limit. In
460 this case, accumulating one huge undo entry could make Emacs crash as
461 a result of memory overflow.
463 In fact, this calls the function which is the value of
464 `undo-outer-limit-function' with one argument, the size.
465 The text above describes the behavior of the function
466 that variable usually specifies. */);
467 Vundo_outer_limit
= make_number (12000000);
469 DEFVAR_LISP ("undo-outer-limit-function", Vundo_outer_limit_function
,
470 doc
: /* Function to call when an undo list exceeds `undo-outer-limit'.
471 This function is called with one argument, the current undo list size
472 for the most recent command (since the last undo boundary).
473 If the function returns t, that means truncation has been fully handled.
474 If it returns nil, the other forms of truncation are done.
476 Garbage collection is inhibited around the call to this function,
477 so it must make sure not to do a lot of consing. */);
478 Vundo_outer_limit_function
= Qnil
;
480 DEFVAR_BOOL ("undo-inhibit-record-point", undo_inhibit_record_point
,
481 doc
: /* Non-nil means do not record `point' in `buffer-undo-list'. */);
482 undo_inhibit_record_point
= false;