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
void
38
run_undoable_change (void)
39 40 41 42
{
  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

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

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

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

249
  run_undoable_change ();
250

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

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

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

Paul Eggert's avatar
Paul Eggert committed
264
DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0,
265 266 267
       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
268
  (void)
Jim Blandy's avatar
Jim Blandy committed
269 270
{
  Lisp_Object tem;
Tom Tromey's avatar
Tom Tromey committed
271
  if (EQ (BVAR (current_buffer, undo_list), Qt))
Jim Blandy's avatar
Jim Blandy committed
272
    return Qnil;
Tom Tromey's avatar
Tom Tromey committed
273
  tem = Fcar (BVAR (current_buffer, undo_list));
Jim Blandy's avatar
Jim Blandy committed
274
  if (!NILP (tem))
275 276 277 278 279 280
    {
      /* 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
281
	  XSETCDR (pending_boundary, BVAR (current_buffer, undo_list));
Paul Eggert's avatar
Paul Eggert committed
282
	  bset_undo_list (current_buffer, pending_boundary);
283 284 285
	  pending_boundary = Qnil;
	}
      else
Paul Eggert's avatar
Paul Eggert committed
286 287
	bset_undo_list (current_buffer,
			Fcons (Qnil, BVAR (current_buffer, undo_list)));
288
    }
289 290
  last_boundary_position = PT;
  last_boundary_buffer = current_buffer;
291 292

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

/* At garbage collection time, make an undo list shorter at the end,
297 298 299 300 301
   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
302
truncate_undo_list (struct buffer *b)
Jim Blandy's avatar
Jim Blandy committed
303
{
304
  Lisp_Object list;
Jim Blandy's avatar
Jim Blandy committed
305
  Lisp_Object prev, next, last_boundary;
306
  EMACS_INT size_so_far = 0;
Jim Blandy's avatar
Jim Blandy committed
307

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

  /* 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.  */
315
  record_unwind_current_buffer ();
316 317
  set_buffer_internal (b);

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

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

324
  /* If the first element is an undo boundary, skip past it.  */
325
  if (CONSP (next) && NILP (XCAR (next)))
Jim Blandy's avatar
Jim Blandy committed
326 327 328 329 330 331
    {
      /* 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;
332
      next = XCDR (next);
Jim Blandy's avatar
Jim Blandy committed
333
    }
334

335 336 337 338 339 340
  /* 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.  */

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

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

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

361 362
  /* 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.  */
363 364
  if (INTEGERP (Vundo_outer_limit)
      && size_so_far > XINT (Vundo_outer_limit)
365 366
      && !NILP (Vundo_outer_limit_function))
    {
367
      Lisp_Object tem;
368 369

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

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

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

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

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

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

  /* If we scanned the whole list, it is short enough; don't change it.  */
Jim Blandy's avatar
Jim Blandy committed
418
  if (NILP (next))
419
    ;
Jim Blandy's avatar
Jim Blandy committed
420
  /* Truncate at the boundary where we decided to truncate.  */
421 422 423
  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
424
  else
Paul Eggert's avatar
Paul Eggert committed
425
    bset_undo_list (b, Qnil);
426 427

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

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

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

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

445 446
  last_boundary_buffer = NULL;

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

449
  DEFVAR_INT ("undo-limit", undo_limit,
450 451 452 453 454 455 456
	      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.  */);
457
  undo_limit = 80000;
458

459
  DEFVAR_INT ("undo-strong-limit", undo_strong_limit,
460 461 462 463 464 465 466 467 468
	      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.  */);
469
  undo_strong_limit = 120000;
470

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

477 478 479 480
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.
481 482 483 484 485

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.  */);
486
  Vundo_outer_limit = make_number (12000000);
487

488
  DEFVAR_LISP ("undo-outer-limit-function", Vundo_outer_limit_function,
489 490 491 492 493 494 495 496 497
	       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;
498

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