undo.c 15.4 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* undo handling for GNU Emacs.
Paul Eggert's avatar
Paul Eggert committed
2
   Copyright (C) 1990, 1993-1994, 2000-2015 Free Software Foundation,
3
   Inc.
Jim Blandy's avatar
Jim Blandy committed
4 5 6

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 10
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
11

Jim Blandy's avatar
Jim Blandy committed
12
GNU Emacs is distributed in the hope that it will be useful,
13 14 15 16 17
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

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/>.  */
Jim Blandy's avatar
Jim Blandy committed
19 20


21
#include <config.h>
22

Jim Blandy's avatar
Jim Blandy committed
23 24 25
#include "lisp.h"
#include "buffer.h"

26
/* Position of point last time we inserted a boundary.  */
27
static struct buffer *last_boundary_buffer;
28
static ptrdiff_t last_boundary_position;
Jim Blandy's avatar
Jim Blandy committed
29

30 31 32 33 34
/* The first time a command records something for undo.
   it also allocates the undo-boundary object
   which will be added to the list at the end of the command.
   This ensures we can't run out of space while trying to make
   an undo-boundary.  */
35
static Lisp_Object pending_boundary;
36

37 38 39 40 41 42
void
run_undoable_change ()
{
  call0 (Qundo_auto__undoable_change);
}

Stefan Monnier's avatar
Stefan Monnier committed
43
/* Record point as it was at beginning of this command (if necessary)
44
   and prepare the undo info for recording a change.
Stefan Monnier's avatar
Stefan Monnier committed
45 46
   PT is the position of point that will naturally occur as a result of the
   undo record that will be added just after this command terminates.  */
Jim Blandy's avatar
Jim Blandy committed
47

Stefan Monnier's avatar
Stefan Monnier committed
48
static void
49
record_point (ptrdiff_t pt)
Jim Blandy's avatar
Jim Blandy committed
50
{
Paul Eggert's avatar
Paul Eggert committed
51
  bool at_boundary;
52

53
  /* Don't record position of pt when undo_inhibit_record_point holds.  */
54 55 56
  if (undo_inhibit_record_point)
    return;

57 58 59 60
  /* Allocate a cons cell to be the undo boundary after this command.  */
  if (NILP (pending_boundary))
    pending_boundary = Fcons (Qnil, Qnil);

61
  run_undoable_change ();
Jim Blandy's avatar
Jim Blandy committed
62

63 64
  at_boundary = ! CONSP (BVAR (current_buffer, undo_list))
                || NILP (XCAR (BVAR (current_buffer, undo_list)));
Stefan Monnier's avatar
Stefan Monnier committed
65

66
  if (MODIFF <= SAVE_MODIFF)
Jim Blandy's avatar
Jim Blandy committed
67 68
    record_first_change ();

69
  /* If we are just after an undo boundary, and
Stefan Monnier's avatar
Stefan Monnier committed
70 71
     point wasn't at start of deleted range, record where it was.  */
  if (at_boundary
72 73
      && current_buffer == last_boundary_buffer
      && last_boundary_position != pt)
Paul Eggert's avatar
Paul Eggert committed
74 75 76
    bset_undo_list (current_buffer,
		    Fcons (make_number (last_boundary_position),
			   BVAR (current_buffer, undo_list)));
Stefan Monnier's avatar
Stefan Monnier committed
77 78 79 80 81 82 83 84
}

/* Record an insertion that just happened or is about to happen,
   for LENGTH characters at position BEG.
   (It is possible to record an insertion before or after the fact
   because we don't need to record the contents.)  */

void
85
record_insert (ptrdiff_t beg, ptrdiff_t length)
Stefan Monnier's avatar
Stefan Monnier committed
86 87 88
{
  Lisp_Object lbeg, lend;

Tom Tromey's avatar
Tom Tromey committed
89
  if (EQ (BVAR (current_buffer, undo_list), Qt))
Stefan Monnier's avatar
Stefan Monnier committed
90 91 92 93
    return;

  record_point (beg);

Jim Blandy's avatar
Jim Blandy committed
94 95
  /* If this is following another insertion and consecutive with it
     in the buffer, combine the two.  */
Tom Tromey's avatar
Tom Tromey committed
96
  if (CONSP (BVAR (current_buffer, undo_list)))
Jim Blandy's avatar
Jim Blandy committed
97 98
    {
      Lisp_Object elt;
Tom Tromey's avatar
Tom Tromey committed
99
      elt = XCAR (BVAR (current_buffer, undo_list));
100
      if (CONSP (elt)
101 102 103
	  && INTEGERP (XCAR (elt))
	  && INTEGERP (XCDR (elt))
	  && XINT (XCDR (elt)) == beg)
Jim Blandy's avatar
Jim Blandy committed
104
	{
105
	  XSETCDR (elt, make_number (beg + length));
Jim Blandy's avatar
Jim Blandy committed
106 107 108 109
	  return;
	}
    }

110 111
  XSETFASTINT (lbeg, beg);
  XSETINT (lend, beg + length);
Paul Eggert's avatar
Paul Eggert committed
112 113
  bset_undo_list (current_buffer,
		  Fcons (Fcons (lbeg, lend), BVAR (current_buffer, undo_list)));
Jim Blandy's avatar
Jim Blandy committed
114 115
}

116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132
/* Record the fact that markers in the region of FROM, TO are about to
   be adjusted.  This is done only when a marker points within text
   being deleted, because that's the only case where an automatic
   marker adjustment won't be inverted automatically by undoing the
   buffer modification.  */

static void
record_marker_adjustments (ptrdiff_t from, ptrdiff_t to)
{
  Lisp_Object marker;
  register struct Lisp_Marker *m;
  register ptrdiff_t charpos, adjustment;

  /* Allocate a cons cell to be the undo boundary after this command.  */
  if (NILP (pending_boundary))
    pending_boundary = Fcons (Qnil, Qnil);

133
  run_undoable_change ();
134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165

  for (m = BUF_MARKERS (current_buffer); m; m = m->next)
    {
      charpos = m->charpos;
      eassert (charpos <= Z);

      if (from <= charpos && charpos <= to)
        {
          /* insertion_type nil markers will end up at the beginning of
             the re-inserted text after undoing a deletion, and must be
             adjusted to move them to the correct place.

             insertion_type t markers will automatically move forward
             upon re-inserting the deleted text, so we have to arrange
             for them to move backward to the correct position.  */
          adjustment = (m->insertion_type ? to : from) - charpos;

          if (adjustment)
            {
              XSETMISC (marker, m);
              bset_undo_list
                (current_buffer,
                 Fcons (Fcons (marker, make_number (adjustment)),
                        BVAR (current_buffer, undo_list)));
            }
        }
    }
}

/* Record that a deletion is about to take place, of the characters in
   STRING, at location BEG.  Optionally record adjustments for markers
   in the region STRING occupies in the current buffer.  */
Jim Blandy's avatar
Jim Blandy committed
166

167
void
168
record_delete (ptrdiff_t beg, Lisp_Object string, bool record_markers)
Jim Blandy's avatar
Jim Blandy committed
169
{
170
  Lisp_Object sbeg;
Jim Blandy's avatar
Jim Blandy committed
171

Tom Tromey's avatar
Tom Tromey committed
172
  if (EQ (BVAR (current_buffer, undo_list), Qt))
173 174
    return;

175
  if (PT == beg + SCHARS (string))
176
    {
Stefan Monnier's avatar
Stefan Monnier committed
177 178
      XSETINT (sbeg, -beg);
      record_point (PT);
179 180
    }
  else
Stefan Monnier's avatar
Stefan Monnier committed
181 182 183 184
    {
      XSETFASTINT (sbeg, beg);
      record_point (beg);
    }
185

186 187 188 189 190
  /* primitive-undo assumes marker adjustments are recorded
     immediately before the deletion is recorded.  See bug 16818
     discussion.  */
  if (record_markers)
    record_marker_adjustments (beg, beg + SCHARS (string));
191

Paul Eggert's avatar
Paul Eggert committed
192 193
  bset_undo_list
    (current_buffer,
194
     Fcons (Fcons (string, sbeg), BVAR (current_buffer, undo_list)));
195 196
}

Jim Blandy's avatar
Jim Blandy committed
197 198
/* Record that a replacement is about to take place,
   for LENGTH characters at location BEG.
199
   The replacement must not change the number of characters.  */
Jim Blandy's avatar
Jim Blandy committed
200

201
void
202
record_change (ptrdiff_t beg, ptrdiff_t length)
Jim Blandy's avatar
Jim Blandy committed
203
{
204
  record_delete (beg, make_buffer_string (beg, beg + length, true), false);
Jim Blandy's avatar
Jim Blandy committed
205 206 207 208 209 210 211
  record_insert (beg, length);
}

/* Record that an unmodified buffer is about to be changed.
   Record the file modification date so that when undoing this entry
   we can tell whether it is obsolete because the file was saved again.  */

212
void
213
record_first_change (void)
Jim Blandy's avatar
Jim Blandy committed
214
{
215
  struct buffer *base_buffer = current_buffer;
216

Tom Tromey's avatar
Tom Tromey committed
217
  if (EQ (BVAR (current_buffer, undo_list), Qt))
218 219
    return;

220 221 222
  if (base_buffer->base_buffer)
    base_buffer = base_buffer->base_buffer;

Paul Eggert's avatar
Paul Eggert committed
223 224 225
  bset_undo_list (current_buffer,
		  Fcons (Fcons (Qt, Fvisited_file_modtime ()),
			 BVAR (current_buffer, undo_list)));
Jim Blandy's avatar
Jim Blandy committed
226 227
}

228 229 230
/* Record a change in property PROP (whose old value was VAL)
   for LENGTH characters starting at position BEG in BUFFER.  */

231
void
232
record_property_change (ptrdiff_t beg, ptrdiff_t length,
233 234
			Lisp_Object prop, Lisp_Object value,
			Lisp_Object buffer)
235 236
{
  Lisp_Object lbeg, lend, entry;
237
  struct buffer *obuf = current_buffer, *buf = XBUFFER (buffer);
238
  bool boundary = false;
239

Tom Tromey's avatar
Tom Tromey committed
240
  if (EQ (BVAR (buf, undo_list), Qt))
241 242
    return;

243 244 245 246
  /* Allocate a cons cell to be the undo boundary after this command.  */
  if (NILP (pending_boundary))
    pending_boundary = Fcons (Qnil, Qnil);

247
  /* Switch temporarily to the buffer that was changed.  */
248
  set_buffer_internal (buf);
249

250
  run_undoable_change ();
251

252
  if (MODIFF <= SAVE_MODIFF)
253 254
    record_first_change ();

255 256
  XSETINT (lbeg, beg);
  XSETINT (lend, beg + length);
257
  entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend))));
Paul Eggert's avatar
Paul Eggert committed
258 259
  bset_undo_list (current_buffer,
		  Fcons (entry, BVAR (current_buffer, undo_list)));
260

261 262
  /* Reset the buffer */
  set_buffer_internal (obuf);
263 264
}

Paul Eggert's avatar
Paul Eggert committed
265
DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0,
266 267 268
       doc: /* Mark a boundary between units of undo.
An undo command will stop at this point,
but another undo command will undo to the previous boundary.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
269
  (void)
Jim Blandy's avatar
Jim Blandy committed
270 271
{
  Lisp_Object tem;
Tom Tromey's avatar
Tom Tromey committed
272
  if (EQ (BVAR (current_buffer, undo_list), Qt))
Jim Blandy's avatar
Jim Blandy committed
273
    return Qnil;
Tom Tromey's avatar
Tom Tromey committed
274
  tem = Fcar (BVAR (current_buffer, undo_list));
Jim Blandy's avatar
Jim Blandy committed
275
  if (!NILP (tem))
276 277 278 279 280 281
    {
      /* One way or another, cons nil onto the front of the undo list.  */
      if (!NILP (pending_boundary))
	{
	  /* If we have preallocated the cons cell to use here,
	     use that one.  */
Tom Tromey's avatar
Tom Tromey committed
282
	  XSETCDR (pending_boundary, BVAR (current_buffer, undo_list));
Paul Eggert's avatar
Paul Eggert committed
283
	  bset_undo_list (current_buffer, pending_boundary);
284 285 286
	  pending_boundary = Qnil;
	}
      else
Paul Eggert's avatar
Paul Eggert committed
287 288
	bset_undo_list (current_buffer,
			Fcons (Qnil, BVAR (current_buffer, undo_list)));
289
    }
290 291
  last_boundary_position = PT;
  last_boundary_buffer = current_buffer;
292 293

  Fset (Qundo_auto__last_boundary_cause, Qexplicit);
Jim Blandy's avatar
Jim Blandy committed
294 295 296 297
  return Qnil;
}

/* At garbage collection time, make an undo list shorter at the end,
298 299 300 301 302
   returning the truncated list.  How this is done depends on the
   variables undo-limit, undo-strong-limit and undo-outer-limit.
   In some cases this works by calling undo-outer-limit-function.  */

void
303
truncate_undo_list (struct buffer *b)
Jim Blandy's avatar
Jim Blandy committed
304
{
305
  Lisp_Object list;
Jim Blandy's avatar
Jim Blandy committed
306
  Lisp_Object prev, next, last_boundary;
307
  EMACS_INT size_so_far = 0;
Jim Blandy's avatar
Jim Blandy committed
308

309 310
  /* Make sure that calling undo-outer-limit-function
     won't cause another GC.  */
311
  ptrdiff_t count = inhibit_garbage_collection ();
312 313 314 315

  /* Make the buffer current to get its local values of variables such
     as undo_limit.  Also so that Vundo_outer_limit_function can
     tell which buffer to operate on.  */
316
  record_unwind_current_buffer ();
317 318
  set_buffer_internal (b);

Tom Tromey's avatar
Tom Tromey committed
319
  list = BVAR (b, undo_list);
320

Jim Blandy's avatar
Jim Blandy committed
321 322 323 324
  prev = Qnil;
  next = list;
  last_boundary = Qnil;

325
  /* If the first element is an undo boundary, skip past it.  */
326
  if (CONSP (next) && NILP (XCAR (next)))
Jim Blandy's avatar
Jim Blandy committed
327 328 329 330 331 332
    {
      /* Add in the space occupied by this element and its chain link.  */
      size_so_far += sizeof (struct Lisp_Cons);

      /* Advance to next element.  */
      prev = next;
333
      next = XCDR (next);
Jim Blandy's avatar
Jim Blandy committed
334
    }
335

336 337 338 339 340 341
  /* Always preserve at least the most recent undo record
     unless it is really horribly big.

     Skip, skip, skip the undo, skip, skip, skip the undo,
     Skip, skip, skip the undo, skip to the undo bound'ry.  */

342
  while (CONSP (next) && ! NILP (XCAR (next)))
Jim Blandy's avatar
Jim Blandy committed
343 344
    {
      Lisp_Object elt;
345
      elt = XCAR (next);
Jim Blandy's avatar
Jim Blandy committed
346 347 348

      /* Add in the space occupied by this element and its chain link.  */
      size_so_far += sizeof (struct Lisp_Cons);
349
      if (CONSP (elt))
Jim Blandy's avatar
Jim Blandy committed
350 351
	{
	  size_so_far += sizeof (struct Lisp_Cons);
352
	  if (STRINGP (XCAR (elt)))
Jim Blandy's avatar
Jim Blandy committed
353
	    size_so_far += (sizeof (struct Lisp_String) - 1
354
			    + SCHARS (XCAR (elt)));
Jim Blandy's avatar
Jim Blandy committed
355 356 357 358
	}

      /* Advance to next element.  */
      prev = next;
359
      next = XCDR (next);
Jim Blandy's avatar
Jim Blandy committed
360
    }
361

362 363
  /* If by the first boundary we have already passed undo_outer_limit,
     we're heading for memory full, so offer to clear out the list.  */
364 365
  if (INTEGERP (Vundo_outer_limit)
      && size_so_far > XINT (Vundo_outer_limit)
366 367
      && !NILP (Vundo_outer_limit_function))
    {
368
      Lisp_Object tem;
369 370

      /* Normally the function this calls is undo-outer-limit-truncate.  */
371 372
      tem = call1 (Vundo_outer_limit_function, make_number (size_so_far));
      if (! NILP (tem))
373 374 375 376 377 378 379 380
	{
	  /* The function is responsible for making
	     any desired changes in buffer-undo-list.  */
	  unbind_to (count, Qnil);
	  return;
	}
    }

381
  if (CONSP (next))
Jim Blandy's avatar
Jim Blandy committed
382 383
    last_boundary = prev;

384
  /* Keep additional undo data, if it fits in the limits.  */
385
  while (CONSP (next))
Jim Blandy's avatar
Jim Blandy committed
386 387
    {
      Lisp_Object elt;
388
      elt = XCAR (next);
Jim Blandy's avatar
Jim Blandy committed
389 390

      /* When we get to a boundary, decide whether to truncate
391
	 either before or after it.  The lower threshold, undo_limit,
Jim Blandy's avatar
Jim Blandy committed
392
	 tells us to truncate after it.  If its size pushes past
393
	 the higher threshold undo_strong_limit, we truncate before it.  */
Jim Blandy's avatar
Jim Blandy committed
394
      if (NILP (elt))
Jim Blandy's avatar
Jim Blandy committed
395
	{
396
	  if (size_so_far > undo_strong_limit)
Jim Blandy's avatar
Jim Blandy committed
397 398
	    break;
	  last_boundary = prev;
399
	  if (size_so_far > undo_limit)
Jim Blandy's avatar
Jim Blandy committed
400 401 402 403 404
	    break;
	}

      /* Add in the space occupied by this element and its chain link.  */
      size_so_far += sizeof (struct Lisp_Cons);
405
      if (CONSP (elt))
Jim Blandy's avatar
Jim Blandy committed
406 407
	{
	  size_so_far += sizeof (struct Lisp_Cons);
408
	  if (STRINGP (XCAR (elt)))
Jim Blandy's avatar
Jim Blandy committed
409
	    size_so_far += (sizeof (struct Lisp_String) - 1
410
			    + SCHARS (XCAR (elt)));
Jim Blandy's avatar
Jim Blandy committed
411 412 413 414
	}

      /* Advance to next element.  */
      prev = next;
415
      next = XCDR (next);
Jim Blandy's avatar
Jim Blandy committed
416 417 418
    }

  /* If we scanned the whole list, it is short enough; don't change it.  */
Jim Blandy's avatar
Jim Blandy committed
419
  if (NILP (next))
420
    ;
Jim Blandy's avatar
Jim Blandy committed
421
  /* Truncate at the boundary where we decided to truncate.  */
422 423 424
  else if (!NILP (last_boundary))
    XSETCDR (last_boundary, Qnil);
  /* There's nothing we decided to keep, so clear it out.  */
Jim Blandy's avatar
Jim Blandy committed
425
  else
Paul Eggert's avatar
Paul Eggert committed
426
    bset_undo_list (b, Qnil);
427 428

  unbind_to (count, Qnil);
Jim Blandy's avatar
Jim Blandy committed
429
}
430

431

Andreas Schwab's avatar
Andreas Schwab committed
432
void
433
syms_of_undo (void)
Jim Blandy's avatar
Jim Blandy committed
434
{
435
  DEFSYM (Qinhibit_read_only, "inhibit-read-only");
436 437 438
  DEFSYM (Qundo_auto__undoable_change, "undo-auto--undoable-change");
  DEFSYM (Qundo_auto__last_boundary_cause, "undo-auto--last-boundary-cause");
  DEFSYM (Qexplicit, "explicit");
439 440

  /* Marker for function call undo list elements.  */
441
  DEFSYM (Qapply, "apply");
Kim F. Storm's avatar
Kim F. Storm committed
442

443 444 445
  pending_boundary = Qnil;
  staticpro (&pending_boundary);

446 447
  last_boundary_buffer = NULL;

Jim Blandy's avatar
Jim Blandy committed
448
  defsubr (&Sundo_boundary);
449

450
  DEFVAR_INT ("undo-limit", undo_limit,
451 452 453 454 455 456 457
	      doc: /* Keep no more undo information once it exceeds this size.
This limit is applied when garbage collection happens.
When a previous command increases the total undo list size past this
value, the earlier commands that came before it are forgotten.

The size is counted as the number of bytes occupied,
which includes both saved text and other data.  */);
458
  undo_limit = 80000;
459

460
  DEFVAR_INT ("undo-strong-limit", undo_strong_limit,
461 462 463 464 465 466 467 468 469
	      doc: /* Don't keep more than this much size of undo information.
This limit is applied when garbage collection happens.
When a previous command increases the total undo list size past this
value, that command and the earlier commands that came before it are forgotten.
However, the most recent buffer-modifying command's undo info
is never discarded for this reason.

The size is counted as the number of bytes occupied,
which includes both saved text and other data.  */);
470
  undo_strong_limit = 120000;
471

472
  DEFVAR_LISP ("undo-outer-limit", Vundo_outer_limit,
473 474
	      doc: /* Outer limit on size of undo information for one command.
At garbage collection time, if the current command has produced
475 476
more than this much undo information, it discards the info and displays
a warning.  This is a last-ditch limit to prevent memory overflow.
477

478 479 480 481
The size is counted as the number of bytes occupied, which includes
both saved text and other data.  A value of nil means no limit.  In
this case, accumulating one huge undo entry could make Emacs crash as
a result of memory overflow.
482 483 484 485 486

In fact, this calls the function which is the value of
`undo-outer-limit-function' with one argument, the size.
The text above describes the behavior of the function
that variable usually specifies.  */);
487
  Vundo_outer_limit = make_number (12000000);
488

489
  DEFVAR_LISP ("undo-outer-limit-function", Vundo_outer_limit_function,
490 491 492 493 494 495 496 497 498
	       doc: /* Function to call when an undo list exceeds `undo-outer-limit'.
This function is called with one argument, the current undo list size
for the most recent command (since the last undo boundary).
If the function returns t, that means truncation has been fully handled.
If it returns nil, the other forms of truncation are done.

Garbage collection is inhibited around the call to this function,
so it must make sure not to do a lot of consing.  */);
  Vundo_outer_limit_function = Qnil;
499

500
  DEFVAR_BOOL ("undo-inhibit-record-point", undo_inhibit_record_point,
501
	       doc: /* Non-nil means do not record `point' in `buffer-undo-list'.  */);
502
  undo_inhibit_record_point = false;
Jim Blandy's avatar
Jim Blandy committed
503
}