code.delx.au - gnu-emacs/blob - src/undo.c

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