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