src/undo.c

   1 /* undo handling for GNU Emacs.
   2    Copyright (C) 1990, 1993-1994, 2000-2015 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
  10 (at 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 <http://www.gnu.org/licenses/>.  */
  19
  20
  21 #include <config.h>
  22
  23 #include "lisp.h"
  24 #include "buffer.h"
  25
  26 /* Position of point last time we inserted a boundary.  */
  27 static struct buffer *last_boundary_buffer;
  28 static ptrdiff_t last_boundary_position;
  29
  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
  34    an undo-boundary.  */
  35 static Lisp_Object pending_boundary;
  36
  37 static void
  38 run_undoable_change (void)
  39 {
  40   call0 (Qundo_auto__undoable_change);
  41 }
  42
  43 /* Record point as it was at beginning of this command (if necessary)
  44    and prepare the undo info for recording a change.
  45    PT is the position of point that will naturally occur as a result of the
  46    undo record that will be added just after this command terminates.  */
  47
  48 static void
  49 record_point (ptrdiff_t pt)
  50 {
  51   bool at_boundary;
  52
  53   /* Don't record position of pt when undo_inhibit_record_point holds.  */
  54   if (undo_inhibit_record_point)
  55     return;
  56
  57   /* Allocate a cons cell to be the undo boundary after this command.  */
  58   if (NILP (pending_boundary))
  59     pending_boundary = Fcons (Qnil, Qnil);
  60
  61   run_undoable_change ();
  62
  63   at_boundary = ! CONSP (BVAR (current_buffer, undo_list))
  64                 || NILP (XCAR (BVAR (current_buffer, undo_list)));
  65
  66   if (MODIFF <= SAVE_MODIFF)
  67     record_first_change ();
  68
  69   /* If we are just after an undo boundary, and
  70      point wasn't at start of deleted range, record where it was.  */
  71   if (at_boundary
  72       && current_buffer == last_boundary_buffer
  73       && last_boundary_position != pt)
  74     bset_undo_list (current_buffer,
  75                     Fcons (make_number (last_boundary_position),
  76                            BVAR (current_buffer, undo_list)));
  77 }
  78
  79 /* Record an insertion that just happened or is about to happen,
  80    for LENGTH characters at position BEG.
  81    (It is possible to record an insertion before or after the fact
  82    because we don't need to record the contents.)  */
  83
  84 void
  85 record_insert (ptrdiff_t beg, ptrdiff_t length)
  86 {
  87   Lisp_Object lbeg, lend;
  88
  89   if (EQ (BVAR (current_buffer, undo_list), Qt))
  90     return;
  91
  92   record_point (beg);
  93
  94   /* If this is following another insertion and consecutive with it
  95      in the buffer, combine the two.  */
  96   if (CONSP (BVAR (current_buffer, undo_list)))
  97     {
  98       Lisp_Object elt;
  99       elt = XCAR (BVAR (current_buffer, undo_list));
 100       if (CONSP (elt)
 101           && INTEGERP (XCAR (elt))
 102           && INTEGERP (XCDR (elt))
 103           && XINT (XCDR (elt)) == beg)
 104         {
 105           XSETCDR (elt, make_number (beg + length));
 106           return;
 107         }
 108     }
 109
 110   XSETFASTINT (lbeg, beg);
 111   XSETINT (lend, beg + length);
 112   bset_undo_list (current_buffer,
 113                   Fcons (Fcons (lbeg, lend), BVAR (current_buffer, undo_list)));
 114 }
 115
 116 /* Record the fact that markers in the region of FROM, TO are about to
 117    be adjusted.  This is done only when a marker points within text
 118    being deleted, because that's the only case where an automatic
 119    marker adjustment won't be inverted automatically by undoing the
 120    buffer modification.  */
 121
 122 static void
 123 record_marker_adjustments (ptrdiff_t from, ptrdiff_t to)
 124 {
 125   Lisp_Object marker;
 126   register struct Lisp_Marker *m;
 127   register ptrdiff_t charpos, adjustment;
 128
 129   /* Allocate a cons cell to be the undo boundary after this command.  */
 130   if (NILP (pending_boundary))
 131     pending_boundary = Fcons (Qnil, Qnil);
 132
 133   run_undoable_change ();
 134
 135   for (m = BUF_MARKERS (current_buffer); m; m = m->next)
 136     {
 137       charpos = m->charpos;
 138       eassert (charpos <= Z);
 139
 140       if (from <= charpos && charpos <= to)
 141         {
 142           /* insertion_type nil markers will end up at the beginning of
 143              the re-inserted text after undoing a deletion, and must be
 144              adjusted to move them to the correct place.
 145
 146              insertion_type t markers will automatically move forward
 147              upon re-inserting the deleted text, so we have to arrange
 148              for them to move backward to the correct position.  */
 149           adjustment = (m->insertion_type ? to : from) - charpos;
 150
 151           if (adjustment)
 152             {
 153               XSETMISC (marker, m);
 154               bset_undo_list
 155                 (current_buffer,
 156                  Fcons (Fcons (marker, make_number (adjustment)),
 157                         BVAR (current_buffer, undo_list)));
 158             }
 159         }
 160     }
 161 }
 162
 163 /* Record that a deletion is about to take place, of the characters in
 164    STRING, at location BEG.  Optionally record adjustments for markers
 165    in the region STRING occupies in the current buffer.  */
 166
 167 void
 168 record_delete (ptrdiff_t beg, Lisp_Object string, bool record_markers)
 169 {
 170   Lisp_Object sbeg;
 171
 172   if (EQ (BVAR (current_buffer, undo_list), Qt))
 173     return;
 174
 175   if (PT == beg + SCHARS (string))
 176     {
 177       XSETINT (sbeg, -beg);
 178       record_point (PT);
 179     }
 180   else
 181     {
 182       XSETFASTINT (sbeg, beg);
 183       record_point (beg);
 184     }
 185
 186   /* primitive-undo assumes marker adjustments are recorded
 187      immediately before the deletion is recorded.  See bug 16818
 188      discussion.  */
 189   if (record_markers)
 190     record_marker_adjustments (beg, beg + SCHARS (string));
 191
 192   bset_undo_list
 193     (current_buffer,
 194      Fcons (Fcons (string, sbeg), BVAR (current_buffer, undo_list)));
 195 }
 196
 197 /* Record that a replacement is about to take place,
 198    for LENGTH characters at location BEG.
 199    The replacement must not change the number of characters.  */
 200
 201 void
 202 record_change (ptrdiff_t beg, ptrdiff_t length)
 203 {
 204   record_delete (beg, make_buffer_string (beg, beg + length, true), false);
 205   record_insert (beg, length);
 206 }
 207 \f
 208 /* Record that an unmodified buffer is about to be changed.
 209    Record the file modification date so that when undoing this entry
 210    we can tell whether it is obsolete because the file was saved again.  */
 211
 212 void
 213 record_first_change (void)
 214 {
 215   struct buffer *base_buffer = current_buffer;
 216
 217   if (EQ (BVAR (current_buffer, undo_list), Qt))
 218     return;
 219
 220   if (base_buffer->base_buffer)
 221     base_buffer = base_buffer->base_buffer;
 222
 223   bset_undo_list (current_buffer,
 224                   Fcons (Fcons (Qt, Fvisited_file_modtime ()),
 225                          BVAR (current_buffer, undo_list)));
 226 }
 227
 228 /* Record a change in property PROP (whose old value was VAL)
 229    for LENGTH characters starting at position BEG in BUFFER.  */
 230
 231 void
 232 record_property_change (ptrdiff_t beg, ptrdiff_t length,
 233                         Lisp_Object prop, Lisp_Object value,
 234                         Lisp_Object buffer)
 235 {
 236   Lisp_Object lbeg, lend, entry;
 237   struct buffer *obuf = current_buffer, *buf = XBUFFER (buffer);
 238
 239   if (EQ (BVAR (buf, undo_list), Qt))
 240     return;
 241
 242   /* Allocate a cons cell to be the undo boundary after this command.  */
 243   if (NILP (pending_boundary))
 244     pending_boundary = Fcons (Qnil, Qnil);
 245
 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     record_first_change ();
 253
 254   XSETINT (lbeg, beg);
 255   XSETINT (lend, beg + length);
 256   entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend))));
 257   bset_undo_list (current_buffer,
 258                   Fcons (entry, BVAR (current_buffer, undo_list)));
 259
 260   /* Reset the buffer */
 261   set_buffer_internal (obuf);
 262 }
 263
 264 DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0,
 265        doc: /* Mark a boundary between units of undo.
 266 An undo command will stop at this point,
 267 but another undo command will undo to the previous boundary.  */)
 268   (void)
 269 {
 270   Lisp_Object tem;
 271   if (EQ (BVAR (current_buffer, undo_list), Qt))
 272     return Qnil;
 273   tem = Fcar (BVAR (current_buffer, undo_list));
 274   if (!NILP (tem))
 275     {
 276       /* One way or another, cons nil onto the front of the undo list.  */
 277       if (!NILP (pending_boundary))
 278         {
 279           /* If we have preallocated the cons cell to use here,
 280              use that one.  */
 281           XSETCDR (pending_boundary, BVAR (current_buffer, undo_list));
 282           bset_undo_list (current_buffer, pending_boundary);
 283           pending_boundary = Qnil;
 284         }
 285       else
 286         bset_undo_list (current_buffer,
 287                         Fcons (Qnil, BVAR (current_buffer, undo_list)));
 288     }
 289   last_boundary_position = PT;
 290   last_boundary_buffer = current_buffer;
 291
 292   Fset (Qundo_auto__last_boundary_cause, Qexplicit);
 293   return Qnil;
 294 }
 295
 296 /* At garbage collection time, make an undo list shorter at the end,
 297    returning the truncated list.  How this is done depends on the
 298    variables undo-limit, undo-strong-limit and undo-outer-limit.
 299    In some cases this works by calling undo-outer-limit-function.  */
 300
 301 void
 302 truncate_undo_list (struct buffer *b)
 303 {
 304   Lisp_Object list;
 305   Lisp_Object prev, next, last_boundary;
 306   EMACS_INT size_so_far = 0;
 307
 308   /* Make sure that calling undo-outer-limit-function
 309      won't cause another GC.  */
 310   ptrdiff_t count = inhibit_garbage_collection ();
 311
 312   /* Make the buffer current to get its local values of variables such
 313      as undo_limit.  Also so that Vundo_outer_limit_function can
 314      tell which buffer to operate on.  */
 315   record_unwind_current_buffer ();
 316   set_buffer_internal (b);
 317
 318   list = BVAR (b, undo_list);
 319
 320   prev = Qnil;
 321   next = list;
 322   last_boundary = Qnil;
 323
 324   /* If the first element is an undo boundary, skip past it.  */
 325   if (CONSP (next) && NILP (XCAR (next)))
 326     {
 327       /* Add in the space occupied by this element and its chain link.  */
 328       size_so_far += sizeof (struct Lisp_Cons);
 329
 330       /* Advance to next element.  */
 331       prev = next;
 332       next = XCDR (next);
 333     }
 334
 335   /* Always preserve at least the most recent undo record
 336      unless it is really horribly big.
 337
 338      Skip, skip, skip the undo, skip, skip, skip the undo,
 339      Skip, skip, skip the undo, skip to the undo bound'ry.  */
 340
 341   while (CONSP (next) && ! NILP (XCAR (next)))
 342     {
 343       Lisp_Object elt;
 344       elt = XCAR (next);
 345
 346       /* Add in the space occupied by this element and its chain link.  */
 347       size_so_far += sizeof (struct Lisp_Cons);
 348       if (CONSP (elt))
 349         {
 350           size_so_far += sizeof (struct Lisp_Cons);
 351           if (STRINGP (XCAR (elt)))
 352             size_so_far += (sizeof (struct Lisp_String) - 1
 353                             + SCHARS (XCAR (elt)));
 354         }
 355
 356       /* Advance to next element.  */
 357       prev = next;
 358       next = XCDR (next);
 359     }
 360
 361   /* If by the first boundary we have already passed undo_outer_limit,
 362      we're heading for memory full, so offer to clear out the list.  */
 363   if (INTEGERP (Vundo_outer_limit)
 364       && size_so_far > XINT (Vundo_outer_limit)
 365       && !NILP (Vundo_outer_limit_function))
 366     {
 367       Lisp_Object tem;
 368
 369       /* Normally the function this calls is undo-outer-limit-truncate.  */
 370       tem = call1 (Vundo_outer_limit_function, make_number (size_so_far));
 371       if (! NILP (tem))
 372         {
 373           /* The function is responsible for making
 374              any desired changes in buffer-undo-list.  */
 375           unbind_to (count, Qnil);
 376           return;
 377         }
 378     }
 379
 380   if (CONSP (next))
 381     last_boundary = prev;
 382
 383   /* Keep additional undo data, if it fits in the limits.  */
 384   while (CONSP (next))
 385     {
 386       Lisp_Object elt;
 387       elt = XCAR (next);
 388
 389       /* When we get to a boundary, decide whether to truncate
 390          either before or after it.  The lower threshold, undo_limit,
 391          tells us to truncate after it.  If its size pushes past
 392          the higher threshold undo_strong_limit, we truncate before it.  */
 393       if (NILP (elt))
 394         {
 395           if (size_so_far > undo_strong_limit)
 396             break;
 397           last_boundary = prev;
 398           if (size_so_far > undo_limit)
 399             break;
 400         }
 401
 402       /* Add in the space occupied by this element and its chain link.  */
 403       size_so_far += sizeof (struct Lisp_Cons);
 404       if (CONSP (elt))
 405         {
 406           size_so_far += sizeof (struct Lisp_Cons);
 407           if (STRINGP (XCAR (elt)))
 408             size_so_far += (sizeof (struct Lisp_String) - 1
 409                             + SCHARS (XCAR (elt)));
 410         }
 411
 412       /* Advance to next element.  */
 413       prev = next;
 414       next = XCDR (next);
 415     }
 416
 417   /* If we scanned the whole list, it is short enough; don't change it.  */
 418   if (NILP (next))
 419     ;
 420   /* Truncate at the boundary where we decided to truncate.  */
 421   else if (!NILP (last_boundary))
 422     XSETCDR (last_boundary, Qnil);
 423   /* There's nothing we decided to keep, so clear it out.  */
 424   else
 425     bset_undo_list (b, Qnil);
 426
 427   unbind_to (count, Qnil);
 428 }
 429
 430 \f
 431 void
 432 syms_of_undo (void)
 433 {
 434   DEFSYM (Qinhibit_read_only, "inhibit-read-only");
 435   DEFSYM (Qundo_auto__undoable_change, "undo-auto--undoable-change");
 436   DEFSYM (Qundo_auto__last_boundary_cause, "undo-auto--last-boundary-cause");
 437   DEFSYM (Qexplicit, "explicit");
 438
 439   /* Marker for function call undo list elements.  */
 440   DEFSYM (Qapply, "apply");
 441
 442   pending_boundary = Qnil;
 443   staticpro (&pending_boundary);
 444
 445   last_boundary_buffer = NULL;
 446
 447   defsubr (&Sundo_boundary);
 448
 449   DEFVAR_INT ("undo-limit", undo_limit,
 450               doc: /* Keep no more undo information once it exceeds this size.
 451 This limit is applied when garbage collection happens.
 452 When a previous command increases the total undo list size past this
 453 value, the earlier commands that came before it are forgotten.
 454
 455 The size is counted as the number of bytes occupied,
 456 which includes both saved text and other data.  */);
 457   undo_limit = 80000;
 458
 459   DEFVAR_INT ("undo-strong-limit", undo_strong_limit,
 460               doc: /* Don't keep more than this much size of undo information.
 461 This limit is applied when garbage collection happens.
 462 When a previous command increases the total undo list size past this
 463 value, that command and the earlier commands that came before it are forgotten.
 464 However, the most recent buffer-modifying command's undo info
 465 is never discarded for this reason.
 466
 467 The size is counted as the number of bytes occupied,
 468 which includes both saved text and other data.  */);
 469   undo_strong_limit = 120000;
 470
 471   DEFVAR_LISP ("undo-outer-limit", Vundo_outer_limit,
 472               doc: /* Outer limit on size of undo information for one command.
 473 At garbage collection time, if the current command has produced
 474 more than this much undo information, it discards the info and displays
 475 a warning.  This is a last-ditch limit to prevent memory overflow.
 476
 477 The size is counted as the number of bytes occupied, which includes
 478 both saved text and other data.  A value of nil means no limit.  In
 479 this case, accumulating one huge undo entry could make Emacs crash as
 480 a result of memory overflow.
 481
 482 In fact, this calls the function which is the value of
 483 `undo-outer-limit-function' with one argument, the size.
 484 The text above describes the behavior of the function
 485 that variable usually specifies.  */);
 486   Vundo_outer_limit = make_number (12000000);
 487
 488   DEFVAR_LISP ("undo-outer-limit-function", Vundo_outer_limit_function,
 489                doc: /* Function to call when an undo list exceeds `undo-outer-limit'.
 490 This function is called with one argument, the current undo list size
 491 for the most recent command (since the last undo boundary).
 492 If the function returns t, that means truncation has been fully handled.
 493 If it returns nil, the other forms of truncation are done.
 494
 495 Garbage collection is inhibited around the call to this function,
 496 so it must make sure not to do a lot of consing.  */);
 497   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;
 502 }