1 /* undo handling for GNU Emacs.
2 Copyright (C) 1990, 1993-1994, 2000-2023 Free Software Foundation,
3 Inc.
4
5 This file is part of GNU Emacs.
6
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 (at
10 your option) any later version.
11
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.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
19
20
21 #include <config.h>
22
23 #include "lisp.h"
24 #include "buffer.h"
25 #include "keyboard.h"
26
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
31 an undo-boundary. */
32 static Lisp_Object pending_boundary;
33
34 /* Prepare the undo info for recording a change. */
35 static void
36 prepare_record (void)
37 {
38 /* Allocate a cons cell to be the undo boundary after this command. */
39 if (NILP (pending_boundary))
40 pending_boundary = Fcons (Qnil, Qnil);
41 }
42
43 /* Record point, if necessary, as it was at beginning of this command.
44 BEG is the position of point that will naturally occur as a result
45 of the undo record that will be added just after this command
46 terminates. */
47 static void
48 record_point (ptrdiff_t beg)
49 {
50 /* Don't record position of pt when undo_inhibit_record_point holds. */
51 if (undo_inhibit_record_point)
52 return;
53
54 bool at_boundary;
55
56 /* Check whether we are at a boundary now, in case we record the
57 first change. FIXME: This check is currently dependent on being
58 called before record_first_change, but could be made not to by
59 ignoring timestamp undo entries */
60 at_boundary = ! CONSP (BVAR (current_buffer, undo_list))
61 || NILP (XCAR (BVAR (current_buffer, undo_list)));
62
63 /* If this is the first change since save, then record this.*/
64 if (MODIFF <= SAVE_MODIFF)
65 record_first_change ();
66
67 /* We may need to record point if we are immediately after a
68 boundary, so that this will be restored correctly after undo. We
69 do not need to do this if point is at the start of a change
70 region since it will be restored there anyway, and we must not do
71 this if the buffer has changed since the last command, since the
72 value of point that we have will be for that buffer, not this.*/
73 if (at_boundary
74 && point_before_last_command_or_undo != beg
75 && buffer_before_last_command_or_undo == current_buffer )
76 bset_undo_list (current_buffer,
77 Fcons (make_fixnum (point_before_last_command_or_undo),
78 BVAR (current_buffer, undo_list)));
79 }
80
81 /* Record an insertion that just happened or is about to happen,
82 for LENGTH characters at position BEG.
83 (It is possible to record an insertion before or after the fact
84 because we don't need to record the contents.) */
85
86 void
87 record_insert (ptrdiff_t beg, ptrdiff_t length)
88 {
89 Lisp_Object lbeg, lend;
90
91 if (EQ (BVAR (current_buffer, undo_list), Qt))
92 return;
93
94 prepare_record ();
95
96 record_point (beg);
97
98 /* If this is following another insertion and consecutive with it
99 in the buffer, combine the two. */
100 if (CONSP (BVAR (current_buffer, undo_list)))
101 {
102 Lisp_Object elt;
103 elt = XCAR (BVAR (current_buffer, undo_list));
104 if (CONSP (elt)
105 && FIXNUMP (XCAR (elt))
106 && FIXNUMP (XCDR (elt))
107 && XFIXNUM (XCDR (elt)) == beg)
108 {
109 XSETCDR (elt, make_fixnum (beg + length));
110 return;
111 }
112 }
113
114 XSETFASTINT (lbeg, beg);
115 XSETINT (lend, beg + length);
116 bset_undo_list (current_buffer,
117 Fcons (Fcons (lbeg, lend), BVAR (current_buffer, undo_list)));
118 }
119
120 /* Record the fact that markers in the region of FROM, TO are about to
121 be adjusted. This is done only when a marker points within text
122 being deleted, because that's the only case where an automatic
123 marker adjustment won't be inverted automatically by undoing the
124 buffer modification. */
125
126 static void
127 record_marker_adjustments (ptrdiff_t from, ptrdiff_t to)
128 {
129 prepare_record ();
130
131 for (struct Lisp_Marker *m = BUF_MARKERS (current_buffer); m; m = m->next)
132 {
133 ptrdiff_t charpos = m->charpos;
134 eassert (charpos <= Z);
135
136 if (from <= charpos && charpos <= to)
137 {
138 /* insertion_type nil markers will end up at the beginning of
139 the re-inserted text after undoing a deletion, and must be
140 adjusted to move them to the correct place.
141
142 insertion_type t markers will automatically move forward
143 upon re-inserting the deleted text, so we have to arrange
144 for them to move backward to the correct position. */
145 ptrdiff_t adjustment = (m->insertion_type ? to : from) - charpos;
146
147 if (adjustment)
148 {
149 Lisp_Object marker = make_lisp_ptr (m, Lisp_Vectorlike);
150 bset_undo_list
151 (current_buffer,
152 Fcons (Fcons (marker, make_fixnum (adjustment)),
153 BVAR (current_buffer, undo_list)));
154 }
155 }
156 }
157 }
158
159 /* Record that a deletion is about to take place, of the characters in
160 STRING, at location BEG. Optionally record adjustments for markers
161 in the region STRING occupies in the current buffer. */
162 void
163 record_delete (ptrdiff_t beg, Lisp_Object string, bool record_markers)
164 {
165 Lisp_Object sbeg;
166
167 if (EQ (BVAR (current_buffer, undo_list), Qt))
168 return;
169
170 prepare_record ();
171
172 record_point (beg);
173
174 if (PT == beg + SCHARS (string))
175 {
176 XSETINT (sbeg, -beg);
177 }
178 else
179 {
180 XSETFASTINT (sbeg, beg);
181 }
182
183 /* primitive-undo assumes marker adjustments are recorded
184 immediately before the deletion is recorded. See bug 16818
185 discussion. */
186 if (record_markers)
187 record_marker_adjustments (beg, beg + SCHARS (string));
188
189 bset_undo_list
190 (current_buffer,
191 Fcons (Fcons (string, sbeg), BVAR (current_buffer, undo_list)));
192 }
193
194 /* Record that a replacement is about to take place,
195 for LENGTH characters at location BEG.
196 The replacement must not change the number of characters. */
197
198 void
199 record_change (ptrdiff_t beg, ptrdiff_t length)
200 {
201 record_delete (beg, make_buffer_string (beg, beg + length, true), false);
202 record_insert (beg, length);
203 }
204
205 /* Record that an unmodified buffer is about to be changed.
206 Record the file modification date so that when undoing this entry
207 we can tell whether it is obsolete because the file was saved again. */
208
209 void
210 record_first_change (void)
211 {
212 struct buffer *base_buffer = current_buffer;
213
214 if (EQ (BVAR (current_buffer, undo_list), Qt))
215 return;
216
217 if (base_buffer->base_buffer)
218 base_buffer = base_buffer->base_buffer;
219
220 bset_undo_list (current_buffer,
221 Fcons (Fcons (Qt, buffer_visited_file_modtime (base_buffer)),
222 BVAR (current_buffer, undo_list)));
223 }
224
225 /* Record a change in property PROP (whose old value was VAL)
226 for LENGTH characters starting at position BEG in BUFFER. */
227
228 void
229 record_property_change (ptrdiff_t beg, ptrdiff_t length,
230 Lisp_Object prop, Lisp_Object value,
231 Lisp_Object buffer)
232 {
233 Lisp_Object lbeg, lend, entry;
234 struct buffer *buf = XBUFFER (buffer);
235
236 if (EQ (BVAR (buf, undo_list), Qt))
237 return;
238
239 prepare_record();
240
241 if (MODIFF <= SAVE_MODIFF)
242 record_first_change ();
243
244 XSETINT (lbeg, beg);
245 XSETINT (lend, beg + length);
246 entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend))));
247 bset_undo_list (current_buffer,
248 Fcons (entry, BVAR (current_buffer, undo_list)));
249 }
250
251 DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0,
252 doc: /* Mark a boundary between units of undo.
253 An undo command will stop at this point,
254 but another undo command will undo to the previous boundary. */)
255 (void)
256 {
257 Lisp_Object tem;
258 if (EQ (BVAR (current_buffer, undo_list), Qt))
259 return Qnil;
260 tem = Fcar (BVAR (current_buffer, undo_list));
261 if (!NILP (tem))
262 {
263 /* One way or another, cons nil onto the front of the undo list. */
264 if (!NILP (pending_boundary))
265 {
266 /* If we have preallocated the cons cell to use here,
267 use that one. */
268 XSETCDR (pending_boundary, BVAR (current_buffer, undo_list));
269 bset_undo_list (current_buffer, pending_boundary);
270 pending_boundary = Qnil;
271 }
272 else
273 bset_undo_list (current_buffer,
274 Fcons (Qnil, BVAR (current_buffer, undo_list)));
275 }
276
277 Fset (Qundo_auto__last_boundary_cause, Qexplicit);
278 point_before_last_command_or_undo = PT;
279 buffer_before_last_command_or_undo = current_buffer;
280
281 return Qnil;
282 }
283
284 /* At garbage collection time, make an undo list shorter at the end,
285 returning the truncated list. How this is done depends on the
286 variables undo-limit, undo-strong-limit and undo-outer-limit.
287 In some cases this works by calling undo-outer-limit-function. */
288
289 void
290 truncate_undo_list (struct buffer *b)
291 {
292 Lisp_Object list;
293 Lisp_Object prev, next, last_boundary;
294 intmax_t size_so_far = 0;
295
296 /* Make sure that calling undo-outer-limit-function
297 won't cause another GC. */
298 specpdl_ref count = inhibit_garbage_collection ();
299
300 /* Make the buffer current to get its local values of variables such
301 as undo_limit. Also so that Vundo_outer_limit_function can
302 tell which buffer to operate on. */
303 record_unwind_current_buffer ();
304 set_buffer_internal (b);
305
306 list = BVAR (b, undo_list);
307
308 prev = Qnil;
309 next = list;
310 last_boundary = Qnil;
311
312 /* If the first element is an undo boundary, skip past it. */
313 if (CONSP (next) && NILP (XCAR (next)))
314 {
315 /* Add in the space occupied by this element and its chain link. */
316 size_so_far += sizeof (struct Lisp_Cons);
317
318 /* Advance to next element. */
319 prev = next;
320 next = XCDR (next);
321 }
322
323 /* Always preserve at least the most recent undo record
324 unless it is really horribly big.
325
326 Skip, skip, skip the undo, skip, skip, skip the undo,
327 Skip, skip, skip the undo, skip to the undo bound'ry. */
328
329 while (CONSP (next) && ! NILP (XCAR (next)))
330 {
331 Lisp_Object elt;
332 elt = XCAR (next);
333
334 /* Add in the space occupied by this element and its chain link. */
335 size_so_far += sizeof (struct Lisp_Cons);
336 if (CONSP (elt))
337 {
338 size_so_far += sizeof (struct Lisp_Cons);
339 if (STRINGP (XCAR (elt)))
340 size_so_far += (sizeof (struct Lisp_String) - 1
341 + SCHARS (XCAR (elt)));
342 }
343
344 /* Advance to next element. */
345 prev = next;
346 next = XCDR (next);
347 }
348
349 /* If by the first boundary we have already passed undo_outer_limit,
350 we're heading for memory full, so offer to clear out the list. */
351 intmax_t undo_outer_limit;
352 if ((INTEGERP (Vundo_outer_limit)
353 && (integer_to_intmax (Vundo_outer_limit, &undo_outer_limit)
354 ? undo_outer_limit < size_so_far
355 : NILP (Fnatnump (Vundo_outer_limit))))
356 && !NILP (Vundo_outer_limit_function))
357 {
358 Lisp_Object tem;
359
360 /* Normally the function this calls is undo-outer-limit-truncate. */
361 tem = call1 (Vundo_outer_limit_function, make_int (size_so_far));
362 if (! NILP (tem))
363 {
364 /* The function is responsible for making
365 any desired changes in buffer-undo-list. */
366 unbind_to (count, Qnil);
367 return;
368 }
369 }
370
371 if (CONSP (next))
372 last_boundary = prev;
373
374 /* Keep additional undo data, if it fits in the limits. */
375 while (CONSP (next))
376 {
377 Lisp_Object elt;
378 elt = XCAR (next);
379
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. */
384 if (NILP (elt))
385 {
386 if (size_so_far > undo_strong_limit)
387 break;
388 last_boundary = prev;
389 if (size_so_far > undo_limit)
390 break;
391 }
392
393 /* Add in the space occupied by this element and its chain link. */
394 size_so_far += sizeof (struct Lisp_Cons);
395 if (CONSP (elt))
396 {
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)));
401 }
402
403 /* Advance to next element. */
404 prev = next;
405 next = XCDR (next);
406 }
407
408 /* If we scanned the whole list, it is short enough; don't change it. */
409 if (NILP (next))
410 ;
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. */
415 else
416 bset_undo_list (b, Qnil);
417
418 unbind_to (count, Qnil);
419 }
420
421
422 void
423 syms_of_undo (void)
424 {
425 DEFSYM (Qinhibit_read_only, "inhibit-read-only");
426 DEFSYM (Qundo_auto__last_boundary_cause, "undo-auto--last-boundary-cause");
427 DEFSYM (Qexplicit, "explicit");
428
429 /* Marker for function call undo list elements. */
430 DEFSYM (Qapply, "apply");
431
432 pending_boundary = Qnil;
433 staticpro (&pending_boundary);
434
435 defsubr (&Sundo_boundary);
436
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.
442
443 The size is counted as the number of bytes occupied,
444 which includes both saved text and other data. */);
445 undo_limit = 160000;
446
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.
454
455 The size is counted as the number of bytes occupied,
456 which includes both saved text and other data. */);
457 undo_strong_limit = 240000;
458
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.
464
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.
469
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_fixnum (24000000);
475
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.
482
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;
486
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;
490 }