src/undo.c

   1 /* undo handling for GNU Emacs.
   2    Copyright (C) 1990, 1993-1994, 2000-2018 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_number (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           && INTEGERP (XCAR (elt))
 106           && INTEGERP (XCDR (elt))
 107           && XINT (XCDR (elt)) == beg)
 108         {
 109           XSETCDR (elt, make_number (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   Lisp_Object marker;
 130   register struct Lisp_Marker *m;
 131   register ptrdiff_t charpos, adjustment;
 132
 133   prepare_record();
 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 void
 167 record_delete (ptrdiff_t beg, Lisp_Object string, bool record_markers)
 168 {
 169   Lisp_Object sbeg;
 170
 171   if (EQ (BVAR (current_buffer, undo_list), Qt))
 172     return;
 173
 174   prepare_record ();
 175
 176   record_point (beg);
 177
 178   if (PT == beg + SCHARS (string))
 179     {
 180       XSETINT (sbeg, -beg);
 181     }
 182   else
 183     {
 184       XSETFASTINT (sbeg, beg);
 185     }
 186
 187   /* primitive-undo assumes marker adjustments are recorded
 188      immediately before the deletion is recorded.  See bug 16818
 189      discussion.  */
 190   if (record_markers)
 191     record_marker_adjustments (beg, beg + SCHARS (string));
 192
 193   bset_undo_list
 194     (current_buffer,
 195      Fcons (Fcons (string, sbeg), BVAR (current_buffer, undo_list)));
 196 }
 197
 198 /* Record that a replacement is about to take place,
 199    for LENGTH characters at location BEG.
 200    The replacement must not change the number of characters.  */
 201
 202 void
 203 record_change (ptrdiff_t beg, ptrdiff_t length)
 204 {
 205   record_delete (beg, make_buffer_string (beg, beg + length, true), false);
 206   record_insert (beg, length);
 207 }
 208 \f
 209 /* Record that an unmodified buffer is about to be changed.
 210    Record the file modification date so that when undoing this entry
 211    we can tell whether it is obsolete because the file was saved again.  */
 212
 213 void
 214 record_first_change (void)
 215 {
 216   struct buffer *base_buffer = current_buffer;
 217
 218   if (EQ (BVAR (current_buffer, undo_list), Qt))
 219     return;
 220
 221   if (base_buffer->base_buffer)
 222     base_buffer = base_buffer->base_buffer;
 223
 224   bset_undo_list (current_buffer,
 225                   Fcons (Fcons (Qt, Fvisited_file_modtime ()),
 226                          BVAR (current_buffer, undo_list)));
 227 }
 228
 229 /* Record a change in property PROP (whose old value was VAL)
 230    for LENGTH characters starting at position BEG in BUFFER.  */
 231
 232 void
 233 record_property_change (ptrdiff_t beg, ptrdiff_t length,
 234                         Lisp_Object prop, Lisp_Object value,
 235                         Lisp_Object buffer)
 236 {
 237   Lisp_Object lbeg, lend, entry;
 238   struct buffer *buf = XBUFFER (buffer);
 239
 240   if (EQ (BVAR (buf, undo_list), Qt))
 241     return;
 242
 243   prepare_record();
 244
 245   if (MODIFF <= SAVE_MODIFF)
 246     record_first_change ();
 247
 248   XSETINT (lbeg, beg);
 249   XSETINT (lend, beg + length);
 250   entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend))));
 251   bset_undo_list (current_buffer,
 252                   Fcons (entry, BVAR (current_buffer, undo_list)));
 253 }
 254
 255 DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0,
 256        doc: /* Mark a boundary between units of undo.
 257 An undo command will stop at this point,
 258 but another undo command will undo to the previous boundary.  */)
 259   (void)
 260 {
 261   Lisp_Object tem;
 262   if (EQ (BVAR (current_buffer, undo_list), Qt))
 263     return Qnil;
 264   tem = Fcar (BVAR (current_buffer, undo_list));
 265   if (!NILP (tem))
 266     {
 267       /* One way or another, cons nil onto the front of the undo list.  */
 268       if (!NILP (pending_boundary))
 269         {
 270           /* If we have preallocated the cons cell to use here,
 271              use that one.  */
 272           XSETCDR (pending_boundary, BVAR (current_buffer, undo_list));
 273           bset_undo_list (current_buffer, pending_boundary);
 274           pending_boundary = Qnil;
 275         }
 276       else
 277         bset_undo_list (current_buffer,
 278                         Fcons (Qnil, BVAR (current_buffer, undo_list)));
 279     }
 280
 281   Fset (Qundo_auto__last_boundary_cause, Qexplicit);
 282   point_before_last_command_or_undo = PT;
 283   buffer_before_last_command_or_undo = current_buffer;
 284
 285   return Qnil;
 286 }
 287
 288 /* At garbage collection time, make an undo list shorter at the end,
 289    returning the truncated list.  How this is done depends on the
 290    variables undo-limit, undo-strong-limit and undo-outer-limit.
 291    In some cases this works by calling undo-outer-limit-function.  */
 292
 293 void
 294 truncate_undo_list (struct buffer *b)
 295 {
 296   Lisp_Object list;
 297   Lisp_Object prev, next, last_boundary;
 298   EMACS_INT size_so_far = 0;
 299
 300   /* Make sure that calling undo-outer-limit-function
 301      won't cause another GC.  */
 302   ptrdiff_t count = inhibit_garbage_collection ();
 303
 304   /* Make the buffer current to get its local values of variables such
 305      as undo_limit.  Also so that Vundo_outer_limit_function can
 306      tell which buffer to operate on.  */
 307   record_unwind_current_buffer ();
 308   set_buffer_internal (b);
 309
 310   list = BVAR (b, undo_list);
 311
 312   prev = Qnil;
 313   next = list;
 314   last_boundary = Qnil;
 315
 316   /* If the first element is an undo boundary, skip past it.  */
 317   if (CONSP (next) && NILP (XCAR (next)))
 318     {
 319       /* Add in the space occupied by this element and its chain link.  */
 320       size_so_far += sizeof (struct Lisp_Cons);
 321
 322       /* Advance to next element.  */
 323       prev = next;
 324       next = XCDR (next);
 325     }
 326
 327   /* Always preserve at least the most recent undo record
 328      unless it is really horribly big.
 329
 330      Skip, skip, skip the undo, skip, skip, skip the undo,
 331      Skip, skip, skip the undo, skip to the undo bound'ry.  */
 332
 333   while (CONSP (next) && ! NILP (XCAR (next)))
 334     {
 335       Lisp_Object elt;
 336       elt = XCAR (next);
 337
 338       /* Add in the space occupied by this element and its chain link.  */
 339       size_so_far += sizeof (struct Lisp_Cons);
 340       if (CONSP (elt))
 341         {
 342           size_so_far += sizeof (struct Lisp_Cons);
 343           if (STRINGP (XCAR (elt)))
 344             size_so_far += (sizeof (struct Lisp_String) - 1
 345                             + SCHARS (XCAR (elt)));
 346         }
 347
 348       /* Advance to next element.  */
 349       prev = next;
 350       next = XCDR (next);
 351     }
 352
 353   /* If by the first boundary we have already passed undo_outer_limit,
 354      we're heading for memory full, so offer to clear out the list.  */
 355   if (INTEGERP (Vundo_outer_limit)
 356       && size_so_far > XINT (Vundo_outer_limit)
 357       && !NILP (Vundo_outer_limit_function))
 358     {
 359       Lisp_Object tem;
 360
 361       /* Normally the function this calls is undo-outer-limit-truncate.  */
 362       tem = call1 (Vundo_outer_limit_function, make_number (size_so_far));
 363       if (! NILP (tem))
 364         {
 365           /* The function is responsible for making
 366              any desired changes in buffer-undo-list.  */
 367           unbind_to (count, Qnil);
 368           return;
 369         }
 370     }
 371
 372   if (CONSP (next))
 373     last_boundary = prev;
 374
 375   /* Keep additional undo data, if it fits in the limits.  */
 376   while (CONSP (next))
 377     {
 378       Lisp_Object elt;
 379       elt = XCAR (next);
 380
 381       /* When we get to a boundary, decide whether to truncate
 382          either before or after it.  The lower threshold, undo_limit,
 383          tells us to truncate after it.  If its size pushes past
 384          the higher threshold undo_strong_limit, we truncate before it.  */
 385       if (NILP (elt))
 386         {
 387           if (size_so_far > undo_strong_limit)
 388             break;
 389           last_boundary = prev;
 390           if (size_so_far > undo_limit)
 391             break;
 392         }
 393
 394       /* Add in the space occupied by this element and its chain link.  */
 395       size_so_far += sizeof (struct Lisp_Cons);
 396       if (CONSP (elt))
 397         {
 398           size_so_far += sizeof (struct Lisp_Cons);
 399           if (STRINGP (XCAR (elt)))
 400             size_so_far += (sizeof (struct Lisp_String) - 1
 401                             + SCHARS (XCAR (elt)));
 402         }
 403
 404       /* Advance to next element.  */
 405       prev = next;
 406       next = XCDR (next);
 407     }
 408
 409   /* If we scanned the whole list, it is short enough; don't change it.  */
 410   if (NILP (next))
 411     ;
 412   /* Truncate at the boundary where we decided to truncate.  */
 413   else if (!NILP (last_boundary))
 414     XSETCDR (last_boundary, Qnil);
 415   /* There's nothing we decided to keep, so clear it out.  */
 416   else
 417     bset_undo_list (b, Qnil);
 418
 419   unbind_to (count, Qnil);
 420 }
 421
 422 \f
 423 void
 424 syms_of_undo (void)
 425 {
 426   DEFSYM (Qinhibit_read_only, "inhibit-read-only");
 427   DEFSYM (Qundo_auto__last_boundary_cause, "undo-auto--last-boundary-cause");
 428   DEFSYM (Qexplicit, "explicit");
 429
 430   /* Marker for function call undo list elements.  */
 431   DEFSYM (Qapply, "apply");
 432
 433   pending_boundary = Qnil;
 434   staticpro (&pending_boundary);
 435
 436   defsubr (&Sundo_boundary);
 437
 438   DEFVAR_INT ("undo-limit", undo_limit,
 439               doc: /* Keep no more undo information once it exceeds this size.
 440 This limit is applied when garbage collection happens.
 441 When a previous command increases the total undo list size past this
 442 value, the earlier commands that came before it are forgotten.
 443
 444 The size is counted as the number of bytes occupied,
 445 which includes both saved text and other data.  */);
 446   undo_limit = 80000;
 447
 448   DEFVAR_INT ("undo-strong-limit", undo_strong_limit,
 449               doc: /* Don't keep more than this much size of undo information.
 450 This limit is applied when garbage collection happens.
 451 When a previous command increases the total undo list size past this
 452 value, that command and the earlier commands that came before it are forgotten.
 453 However, the most recent buffer-modifying command's undo info
 454 is never discarded for this reason.
 455
 456 The size is counted as the number of bytes occupied,
 457 which includes both saved text and other data.  */);
 458   undo_strong_limit = 120000;
 459
 460   DEFVAR_LISP ("undo-outer-limit", Vundo_outer_limit,
 461               doc: /* Outer limit on size of undo information for one command.
 462 At garbage collection time, if the current command has produced
 463 more than this much undo information, it discards the info and displays
 464 a warning.  This is a last-ditch limit to prevent memory overflow.
 465
 466 The size is counted as the number of bytes occupied, which includes
 467 both saved text and other data.  A value of nil means no limit.  In
 468 this case, accumulating one huge undo entry could make Emacs crash as
 469 a result of memory overflow.
 470
 471 In fact, this calls the function which is the value of
 472 `undo-outer-limit-function' with one argument, the size.
 473 The text above describes the behavior of the function
 474 that variable usually specifies.  */);
 475   Vundo_outer_limit = make_number (12000000);
 476
 477   DEFVAR_LISP ("undo-outer-limit-function", Vundo_outer_limit_function,
 478                doc: /* Function to call when an undo list exceeds `undo-outer-limit'.
 479 This function is called with one argument, the current undo list size
 480 for the most recent command (since the last undo boundary).
 481 If the function returns t, that means truncation has been fully handled.
 482 If it returns nil, the other forms of truncation are done.
 483
 484 Garbage collection is inhibited around the call to this function,
 485 so it must make sure not to do a lot of consing.  */);
 486   Vundo_outer_limit_function = Qnil;
 487
 488   DEFVAR_BOOL ("undo-inhibit-record-point", undo_inhibit_record_point,
 489                doc: /* Non-nil means do not record `point' in `buffer-undo-list'.  */);
 490   undo_inhibit_record_point = false;
 491 }