src/undo.c

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