src/undo.c

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