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   dynwind_begin ();
 332   static const size_t sizeof_cons = sizeof (scm_t_cell);
 333
 334   /* Make the buffer current to get its local values of variables such
 335      as undo_limit.  Also so that Vundo_outer_limit_function can
 336      tell which buffer to operate on.  */
 337   record_unwind_current_buffer ();
 338   set_buffer_internal (b);
 339
 340   list = BVAR (b, undo_list);
 341
 342   prev = Qnil;
 343   next = list;
 344   last_boundary = Qnil;
 345
 346   /* If the first element is an undo boundary, skip past it.  */
 347   if (CONSP (next) && NILP (XCAR (next)))
 348     {
 349       /* Add in the space occupied by this element and its chain link.  */
 350       size_so_far += sizeof_cons;
 351
 352       /* Advance to next element.  */
 353       prev = next;
 354       next = XCDR (next);
 355     }
 356
 357   /* Always preserve at least the most recent undo record
 358      unless it is really horribly big.
 359
 360      Skip, skip, skip the undo, skip, skip, skip the undo,
 361      Skip, skip, skip the undo, skip to the undo bound'ry.  */
 362
 363   while (CONSP (next) && ! NILP (XCAR (next)))
 364     {
 365       Lisp_Object elt;
 366       elt = XCAR (next);
 367
 368       /* Add in the space occupied by this element and its chain link.  */
 369       size_so_far += sizeof_cons;
 370       if (CONSP (elt))
 371         {
 372           size_so_far += sizeof_cons;
 373           if (STRINGP (XCAR (elt)))
 374             size_so_far += (sizeof (struct Lisp_String) - 1
 375                             + SCHARS (XCAR (elt)));
 376         }
 377
 378       /* Advance to next element.  */
 379       prev = next;
 380       next = XCDR (next);
 381     }
 382
 383   /* If by the first boundary we have already passed undo_outer_limit,
 384      we're heading for memory full, so offer to clear out the list.  */
 385   if (INTEGERP (Vundo_outer_limit)
 386       && size_so_far > XINT (Vundo_outer_limit)
 387       && !NILP (Vundo_outer_limit_function))
 388     {
 389       Lisp_Object tem;
 390       struct buffer *temp = last_undo_buffer;
 391
 392       /* Normally the function this calls is undo-outer-limit-truncate.  */
 393       tem = call1 (Vundo_outer_limit_function, make_number (size_so_far));
 394       if (! NILP (tem))
 395         {
 396           /* The function is responsible for making
 397              any desired changes in buffer-undo-list.  */
 398           dynwind_end ();
 399           return;
 400         }
 401       /* That function probably used the minibuffer, and if so, that
 402          changed last_undo_buffer.  Change it back so that we don't
 403          force next change to make an undo boundary here.  */
 404       last_undo_buffer = temp;
 405     }
 406
 407   if (CONSP (next))
 408     last_boundary = prev;
 409
 410   /* Keep additional undo data, if it fits in the limits.  */
 411   while (CONSP (next))
 412     {
 413       Lisp_Object elt;
 414       elt = XCAR (next);
 415
 416       /* When we get to a boundary, decide whether to truncate
 417          either before or after it.  The lower threshold, undo_limit,
 418          tells us to truncate after it.  If its size pushes past
 419          the higher threshold undo_strong_limit, we truncate before it.  */
 420       if (NILP (elt))
 421         {
 422           if (size_so_far > undo_strong_limit)
 423             break;
 424           last_boundary = prev;
 425           if (size_so_far > undo_limit)
 426             break;
 427         }
 428
 429       /* Add in the space occupied by this element and its chain link.  */
 430       size_so_far += sizeof_cons;
 431       if (CONSP (elt))
 432         {
 433           size_so_far += sizeof_cons;
 434           if (STRINGP (XCAR (elt)))
 435             size_so_far += (sizeof (struct Lisp_String) - 1
 436                             + SCHARS (XCAR (elt)));
 437         }
 438
 439       /* Advance to next element.  */
 440       prev = next;
 441       next = XCDR (next);
 442     }
 443
 444   /* If we scanned the whole list, it is short enough; don't change it.  */
 445   if (NILP (next))
 446     ;
 447   /* Truncate at the boundary where we decided to truncate.  */
 448   else if (!NILP (last_boundary))
 449     XSETCDR (last_boundary, Qnil);
 450   /* There's nothing we decided to keep, so clear it out.  */
 451   else
 452     bset_undo_list (b, Qnil);
 453
 454   dynwind_end ();
 455 }
 456
 457 \f
 458 void
 459 syms_of_undo (void)
 460 {
 461 #include "undo.x"
 462
 463   DEFSYM (Qinhibit_read_only, "inhibit-read-only");
 464   DEFSYM (Qapply, "apply");
 465
 466   pending_boundary = Qnil;
 467   staticpro (&pending_boundary);
 468
 469   last_undo_buffer = NULL;
 470   last_boundary_buffer = NULL;
 471
 472   DEFVAR_INT ("undo-limit", undo_limit,
 473               doc: /* Keep no more undo information once it exceeds this size.
 474 This limit is applied when garbage collection happens.
 475 When a previous command increases the total undo list size past this
 476 value, the earlier commands that came before it are forgotten.
 477
 478 The size is counted as the number of bytes occupied,
 479 which includes both saved text and other data.  */);
 480   undo_limit = 80000;
 481
 482   DEFVAR_INT ("undo-strong-limit", undo_strong_limit,
 483               doc: /* Don't keep more than this much size of undo information.
 484 This limit is applied when garbage collection happens.
 485 When a previous command increases the total undo list size past this
 486 value, that command and the earlier commands that came before it are forgotten.
 487 However, the most recent buffer-modifying command's undo info
 488 is never discarded for this reason.
 489
 490 The size is counted as the number of bytes occupied,
 491 which includes both saved text and other data.  */);
 492   undo_strong_limit = 120000;
 493
 494   DEFVAR_LISP ("undo-outer-limit", Vundo_outer_limit,
 495               doc: /* Outer limit on size of undo information for one command.
 496 At garbage collection time, if the current command has produced
 497 more than this much undo information, it discards the info and displays
 498 a warning.  This is a last-ditch limit to prevent memory overflow.
 499
 500 The size is counted as the number of bytes occupied, which includes
 501 both saved text and other data.  A value of nil means no limit.  In
 502 this case, accumulating one huge undo entry could make Emacs crash as
 503 a result of memory overflow.
 504
 505 In fact, this calls the function which is the value of
 506 `undo-outer-limit-function' with one argument, the size.
 507 The text above describes the behavior of the function
 508 that variable usually specifies.  */);
 509   Vundo_outer_limit = make_number (12000000);
 510
 511   DEFVAR_LISP ("undo-outer-limit-function", Vundo_outer_limit_function,
 512                doc: /* Function to call when an undo list exceeds `undo-outer-limit'.
 513 This function is called with one argument, the current undo list size
 514 for the most recent command (since the last undo boundary).
 515 If the function returns t, that means truncation has been fully handled.
 516 If it returns nil, the other forms of truncation are done.
 517
 518 Garbage collection is inhibited around the call to this function,
 519 so it must make sure not to do a lot of consing.  */);
 520   Vundo_outer_limit_function = Qnil;
 521
 522   DEFVAR_BOOL ("undo-inhibit-record-point", undo_inhibit_record_point,
 523                doc: /* Non-nil means do not record `point' in `buffer-undo-list'.  */);
 524   undo_inhibit_record_point = 0;
 525 }