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 void
  38 run_undoable_change ()
  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   bool boundary = false;
 239
 240   if (EQ (BVAR (buf, undo_list), Qt))
 241     return;
 242
 243   /* Allocate a cons cell to be the undo boundary after this command.  */
 244   if (NILP (pending_boundary))
 245     pending_boundary = Fcons (Qnil, Qnil);
 246
 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     record_first_change ();
 254
 255   XSETINT (lbeg, beg);
 256   XSETINT (lend, beg + length);
 257   entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend))));
 258   bset_undo_list (current_buffer,
 259                   Fcons (entry, BVAR (current_buffer, undo_list)));
 260
 261   /* Reset the buffer */
 262   set_buffer_internal (obuf);
 263 }
 264
 265 DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0,
 266        doc: /* Mark a boundary between units of undo.
 267 An undo command will stop at this point,
 268 but another undo command will undo to the previous boundary.  */)
 269   (void)
 270 {
 271   Lisp_Object tem;
 272   if (EQ (BVAR (current_buffer, undo_list), Qt))
 273     return Qnil;
 274   tem = Fcar (BVAR (current_buffer, undo_list));
 275   if (!NILP (tem))
 276     {
 277       /* One way or another, cons nil onto the front of the undo list.  */
 278       if (!NILP (pending_boundary))
 279         {
 280           /* If we have preallocated the cons cell to use here,
 281              use that one.  */
 282           XSETCDR (pending_boundary, BVAR (current_buffer, undo_list));
 283           bset_undo_list (current_buffer, pending_boundary);
 284           pending_boundary = Qnil;
 285         }
 286       else
 287         bset_undo_list (current_buffer,
 288                         Fcons (Qnil, BVAR (current_buffer, undo_list)));
 289     }
 290   last_boundary_position = PT;
 291   last_boundary_buffer = current_buffer;
 292
 293   Fset (Qundo_auto__last_boundary_cause, Qexplicit);
 294   return Qnil;
 295 }
 296
 297 /* At garbage collection time, make an undo list shorter at the end,
 298    returning the truncated list.  How this is done depends on the
 299    variables undo-limit, undo-strong-limit and undo-outer-limit.
 300    In some cases this works by calling undo-outer-limit-function.  */
 301
 302 void
 303 truncate_undo_list (struct buffer *b)
 304 {
 305   Lisp_Object list;
 306   Lisp_Object prev, next, last_boundary;
 307   EMACS_INT size_so_far = 0;
 308
 309   /* Make sure that calling undo-outer-limit-function
 310      won't cause another GC.  */
 311   ptrdiff_t count = inhibit_garbage_collection ();
 312
 313   /* Make the buffer current to get its local values of variables such
 314      as undo_limit.  Also so that Vundo_outer_limit_function can
 315      tell which buffer to operate on.  */
 316   record_unwind_current_buffer ();
 317   set_buffer_internal (b);
 318
 319   list = BVAR (b, undo_list);
 320
 321   prev = Qnil;
 322   next = list;
 323   last_boundary = Qnil;
 324
 325   /* If the first element is an undo boundary, skip past it.  */
 326   if (CONSP (next) && NILP (XCAR (next)))
 327     {
 328       /* Add in the space occupied by this element and its chain link.  */
 329       size_so_far += sizeof (struct Lisp_Cons);
 330
 331       /* Advance to next element.  */
 332       prev = next;
 333       next = XCDR (next);
 334     }
 335
 336   /* Always preserve at least the most recent undo record
 337      unless it is really horribly big.
 338
 339      Skip, skip, skip the undo, skip, skip, skip the undo,
 340      Skip, skip, skip the undo, skip to the undo bound'ry.  */
 341
 342   while (CONSP (next) && ! NILP (XCAR (next)))
 343     {
 344       Lisp_Object elt;
 345       elt = XCAR (next);
 346
 347       /* Add in the space occupied by this element and its chain link.  */
 348       size_so_far += sizeof (struct Lisp_Cons);
 349       if (CONSP (elt))
 350         {
 351           size_so_far += sizeof (struct Lisp_Cons);
 352           if (STRINGP (XCAR (elt)))
 353             size_so_far += (sizeof (struct Lisp_String) - 1
 354                             + SCHARS (XCAR (elt)));
 355         }
 356
 357       /* Advance to next element.  */
 358       prev = next;
 359       next = XCDR (next);
 360     }
 361
 362   /* If by the first boundary we have already passed undo_outer_limit,
 363      we're heading for memory full, so offer to clear out the list.  */
 364   if (INTEGERP (Vundo_outer_limit)
 365       && size_so_far > XINT (Vundo_outer_limit)
 366       && !NILP (Vundo_outer_limit_function))
 367     {
 368       Lisp_Object tem;
 369
 370       /* Normally the function this calls is undo-outer-limit-truncate.  */
 371       tem = call1 (Vundo_outer_limit_function, make_number (size_so_far));
 372       if (! NILP (tem))
 373         {
 374           /* The function is responsible for making
 375              any desired changes in buffer-undo-list.  */
 376           unbind_to (count, Qnil);
 377           return;
 378         }
 379     }
 380
 381   if (CONSP (next))
 382     last_boundary = prev;
 383
 384   /* Keep additional undo data, if it fits in the limits.  */
 385   while (CONSP (next))
 386     {
 387       Lisp_Object elt;
 388       elt = XCAR (next);
 389
 390       /* When we get to a boundary, decide whether to truncate
 391          either before or after it.  The lower threshold, undo_limit,
 392          tells us to truncate after it.  If its size pushes past
 393          the higher threshold undo_strong_limit, we truncate before it.  */
 394       if (NILP (elt))
 395         {
 396           if (size_so_far > undo_strong_limit)
 397             break;
 398           last_boundary = prev;
 399           if (size_so_far > undo_limit)
 400             break;
 401         }
 402
 403       /* Add in the space occupied by this element and its chain link.  */
 404       size_so_far += sizeof (struct Lisp_Cons);
 405       if (CONSP (elt))
 406         {
 407           size_so_far += sizeof (struct Lisp_Cons);
 408           if (STRINGP (XCAR (elt)))
 409             size_so_far += (sizeof (struct Lisp_String) - 1
 410                             + SCHARS (XCAR (elt)));
 411         }
 412
 413       /* Advance to next element.  */
 414       prev = next;
 415       next = XCDR (next);
 416     }
 417
 418   /* If we scanned the whole list, it is short enough; don't change it.  */
 419   if (NILP (next))
 420     ;
 421   /* Truncate at the boundary where we decided to truncate.  */
 422   else if (!NILP (last_boundary))
 423     XSETCDR (last_boundary, Qnil);
 424   /* There's nothing we decided to keep, so clear it out.  */
 425   else
 426     bset_undo_list (b, Qnil);
 427
 428   unbind_to (count, Qnil);
 429 }
 430
 431 \f
 432 void
 433 syms_of_undo (void)
 434 {
 435   DEFSYM (Qinhibit_read_only, "inhibit-read-only");
 436   DEFSYM (Qundo_auto__undoable_change, "undo-auto--undoable-change");
 437   DEFSYM (Qundo_auto__last_boundary_cause, "undo-auto--last-boundary-cause");
 438   DEFSYM (Qexplicit, "explicit");
 439
 440   /* Marker for function call undo list elements.  */
 441   DEFSYM (Qapply, "apply");
 442
 443   pending_boundary = Qnil;
 444   staticpro (&pending_boundary);
 445
 446   last_boundary_buffer = NULL;
 447
 448   defsubr (&Sundo_boundary);
 449
 450   DEFVAR_INT ("undo-limit", undo_limit,
 451               doc: /* Keep no more undo information once it exceeds this size.
 452 This limit is applied when garbage collection happens.
 453 When a previous command increases the total undo list size past this
 454 value, the earlier commands that came before it are forgotten.
 455
 456 The size is counted as the number of bytes occupied,
 457 which includes both saved text and other data.  */);
 458   undo_limit = 80000;
 459
 460   DEFVAR_INT ("undo-strong-limit", undo_strong_limit,
 461               doc: /* Don't keep more than this much size of undo information.
 462 This limit is applied when garbage collection happens.
 463 When a previous command increases the total undo list size past this
 464 value, that command and the earlier commands that came before it are forgotten.
 465 However, the most recent buffer-modifying command's undo info
 466 is never discarded for this reason.
 467
 468 The size is counted as the number of bytes occupied,
 469 which includes both saved text and other data.  */);
 470   undo_strong_limit = 120000;
 471
 472   DEFVAR_LISP ("undo-outer-limit", Vundo_outer_limit,
 473               doc: /* Outer limit on size of undo information for one command.
 474 At garbage collection time, if the current command has produced
 475 more than this much undo information, it discards the info and displays
 476 a warning.  This is a last-ditch limit to prevent memory overflow.
 477
 478 The size is counted as the number of bytes occupied, which includes
 479 both saved text and other data.  A value of nil means no limit.  In
 480 this case, accumulating one huge undo entry could make Emacs crash as
 481 a result of memory overflow.
 482
 483 In fact, this calls the function which is the value of
 484 `undo-outer-limit-function' with one argument, the size.
 485 The text above describes the behavior of the function
 486 that variable usually specifies.  */);
 487   Vundo_outer_limit = make_number (12000000);
 488
 489   DEFVAR_LISP ("undo-outer-limit-function", Vundo_outer_limit_function,
 490                doc: /* Function to call when an undo list exceeds `undo-outer-limit'.
 491 This function is called with one argument, the current undo list size
 492 for the most recent command (since the last undo boundary).
 493 If the function returns t, that means truncation has been fully handled.
 494 If it returns nil, the other forms of truncation are done.
 495
 496 Garbage collection is inhibited around the call to this function,
 497 so it must make sure not to do a lot of consing.  */);
 498   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;
 503 }