src/undo.c

   1 /* undo handling for GNU Emacs.
   2    Copyright (C) 1990, 1993, 1994 Free Software Foundation, Inc.
   3
   4 This file is part of GNU Emacs.
   5
   6 GNU Emacs is free software; you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation; either version 2, or (at your option)
   9 any later version.
  10
  11 GNU Emacs is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GNU Emacs; see the file COPYING.  If not, write to
  18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  19 Boston, MA 02111-1307, USA.  */
  20
  21
  22 #include <config.h>
  23 #include "lisp.h"
  24 #include "buffer.h"
  25 #include "commands.h"
  26
  27 /* Last buffer for which undo information was recorded.  */
  28 Lisp_Object last_undo_buffer;
  29
  30 Lisp_Object Qinhibit_read_only;
  31
  32 /* The first time a command records something for undo.
  33    it also allocates the undo-boundary object
  34    which will be added to the list at the end of the command.
  35    This ensures we can't run out of space while trying to make
  36    an undo-boundary.  */
  37 Lisp_Object pending_boundary;
  38
  39 /* Record an insertion that just happened or is about to happen,
  40    for LENGTH characters at position BEG.
  41    (It is possible to record an insertion before or after the fact
  42    because we don't need to record the contents.)  */
  43
  44 void
  45 record_insert (beg, length)
  46      int beg, length;
  47 {
  48   Lisp_Object lbeg, lend;
  49
  50   if (EQ (current_buffer->undo_list, Qt))
  51     return;
  52
  53   /* Allocate a cons cell to be the undo boundary after this command.  */
  54   if (NILP (pending_boundary))
  55     pending_boundary = Fcons (Qnil, Qnil);
  56
  57   if (current_buffer != XBUFFER (last_undo_buffer))
  58     Fundo_boundary ();
  59   XSETBUFFER (last_undo_buffer, current_buffer);
  60
  61   if (MODIFF <= SAVE_MODIFF)
  62     record_first_change ();
  63
  64   /* If this is following another insertion and consecutive with it
  65      in the buffer, combine the two.  */
  66   if (CONSP (current_buffer->undo_list))
  67     {
  68       Lisp_Object elt;
  69       elt = XCAR (current_buffer->undo_list);
  70       if (CONSP (elt)
  71           && INTEGERP (XCAR (elt))
  72           && INTEGERP (XCDR (elt))
  73           && XINT (XCDR (elt)) == beg)
  74         {
  75           XSETINT (XCDR (elt), beg + length);
  76           return;
  77         }
  78     }
  79
  80   XSETFASTINT (lbeg, beg);
  81   XSETINT (lend, beg + length);
  82   current_buffer->undo_list = Fcons (Fcons (lbeg, lend),
  83                                      current_buffer->undo_list);
  84 }
  85
  86 /* Record that a deletion is about to take place,
  87    of the characters in STRING, at location BEG.  */
  88
  89 void
  90 record_delete (beg, string)
  91      int beg;
  92      Lisp_Object string;
  93 {
  94   Lisp_Object sbeg;
  95   int at_boundary;
  96
  97   if (EQ (current_buffer->undo_list, Qt))
  98     return;
  99
 100   /* Allocate a cons cell to be the undo boundary after this command.  */
 101   if (NILP (pending_boundary))
 102     pending_boundary = Fcons (Qnil, Qnil);
 103
 104   if (current_buffer != XBUFFER (last_undo_buffer))
 105     Fundo_boundary ();
 106   XSETBUFFER (last_undo_buffer, current_buffer);
 107
 108   if (CONSP (current_buffer->undo_list))
 109     {
 110       /* Set AT_BOUNDARY to 1 only when we have nothing other than
 111          marker adjustment before undo boundary.  */
 112
 113       Lisp_Object tail = current_buffer->undo_list, elt;
 114
 115       while (1)
 116         {
 117           elt = XCAR (tail);
 118           if (NILP (elt) || ! (CONSP (elt) && MARKERP (XCAR (elt))))
 119             break;
 120           tail = XCDR (tail);
 121         }
 122       at_boundary = NILP (elt);
 123     }
 124   else
 125     at_boundary = 0;
 126
 127   if (MODIFF <= SAVE_MODIFF)
 128     record_first_change ();
 129
 130   if (PT == beg + XSTRING (string)->size)
 131     XSETINT (sbeg, -beg);
 132   else
 133     XSETFASTINT (sbeg, beg);
 134
 135   /* If we are just after an undo boundary, and
 136      point wasn't at start of deleted range, record where it was.  */
 137   if (at_boundary
 138       && last_point_position != XFASTINT (sbeg)
 139       && current_buffer == XBUFFER (last_point_position_buffer))
 140     current_buffer->undo_list
 141       = Fcons (make_number (last_point_position), current_buffer->undo_list);
 142
 143   current_buffer->undo_list
 144     = Fcons (Fcons (string, sbeg), current_buffer->undo_list);
 145 }
 146
 147 /* Record the fact that MARKER is about to be adjusted by ADJUSTMENT.
 148    This is done only when a marker points within text being deleted,
 149    because that's the only case where an automatic marker adjustment
 150    won't be inverted automatically by undoing the buffer modification.  */
 151
 152 void
 153 record_marker_adjustment (marker, adjustment)
 154      Lisp_Object marker;
 155      int adjustment;
 156 {
 157   if (EQ (current_buffer->undo_list, Qt))
 158     return;
 159
 160   /* Allocate a cons cell to be the undo boundary after this command.  */
 161   if (NILP (pending_boundary))
 162     pending_boundary = Fcons (Qnil, Qnil);
 163
 164   if (current_buffer != XBUFFER (last_undo_buffer))
 165     Fundo_boundary ();
 166   XSETBUFFER (last_undo_buffer, current_buffer);
 167
 168   current_buffer->undo_list
 169     = Fcons (Fcons (marker, make_number (adjustment)),
 170              current_buffer->undo_list);
 171 }
 172
 173 /* Record that a replacement is about to take place,
 174    for LENGTH characters at location BEG.
 175    The replacement must not change the number of characters.  */
 176
 177 void
 178 record_change (beg, length)
 179      int beg, length;
 180 {
 181   record_delete (beg, make_buffer_string (beg, beg + length, 1));
 182   record_insert (beg, length);
 183 }
 184 \f
 185 /* Record that an unmodified buffer is about to be changed.
 186    Record the file modification date so that when undoing this entry
 187    we can tell whether it is obsolete because the file was saved again.  */
 188
 189 void
 190 record_first_change ()
 191 {
 192   Lisp_Object high, low;
 193   struct buffer *base_buffer = current_buffer;
 194
 195   if (EQ (current_buffer->undo_list, Qt))
 196     return;
 197
 198   if (current_buffer != XBUFFER (last_undo_buffer))
 199     Fundo_boundary ();
 200   XSETBUFFER (last_undo_buffer, current_buffer);
 201
 202   if (base_buffer->base_buffer)
 203     base_buffer = base_buffer->base_buffer;
 204
 205   XSETFASTINT (high, (base_buffer->modtime >> 16) & 0xffff);
 206   XSETFASTINT (low, base_buffer->modtime & 0xffff);
 207   current_buffer->undo_list = Fcons (Fcons (Qt, Fcons (high, low)), current_buffer->undo_list);
 208 }
 209
 210 /* Record a change in property PROP (whose old value was VAL)
 211    for LENGTH characters starting at position BEG in BUFFER.  */
 212
 213 void
 214 record_property_change (beg, length, prop, value, buffer)
 215      int beg, length;
 216      Lisp_Object prop, value, buffer;
 217 {
 218   Lisp_Object lbeg, lend, entry;
 219   struct buffer *obuf = current_buffer;
 220   int boundary = 0;
 221
 222   if (EQ (XBUFFER (buffer)->undo_list, Qt))
 223     return;
 224
 225   /* Allocate a cons cell to be the undo boundary after this command.  */
 226   if (NILP (pending_boundary))
 227     pending_boundary = Fcons (Qnil, Qnil);
 228
 229   if (!EQ (buffer, last_undo_buffer))
 230     boundary = 1;
 231   last_undo_buffer = buffer;
 232
 233   /* Switch temporarily to the buffer that was changed.  */
 234   current_buffer = XBUFFER (buffer);
 235
 236   if (boundary)
 237     Fundo_boundary ();
 238
 239   if (MODIFF <= SAVE_MODIFF)
 240     record_first_change ();
 241
 242   XSETINT (lbeg, beg);
 243   XSETINT (lend, beg + length);
 244   entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend))));
 245   current_buffer->undo_list = Fcons (entry, current_buffer->undo_list);
 246
 247   current_buffer = obuf;
 248 }
 249
 250 DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0,
 251   "Mark a boundary between units of undo.\n\
 252 An undo command will stop at this point,\n\
 253 but another undo command will undo to the previous boundary.")
 254   ()
 255 {
 256   Lisp_Object tem;
 257   if (EQ (current_buffer->undo_list, Qt))
 258     return Qnil;
 259   tem = Fcar (current_buffer->undo_list);
 260   if (!NILP (tem))
 261     {
 262       /* One way or another, cons nil onto the front of the undo list.  */
 263       if (!NILP (pending_boundary))
 264         {
 265           /* If we have preallocated the cons cell to use here,
 266              use that one.  */
 267           XCDR (pending_boundary) = current_buffer->undo_list;
 268           current_buffer->undo_list = pending_boundary;
 269           pending_boundary = Qnil;
 270         }
 271       else
 272         current_buffer->undo_list = Fcons (Qnil, current_buffer->undo_list);
 273     }
 274   return Qnil;
 275 }
 276
 277 /* At garbage collection time, make an undo list shorter at the end,
 278    returning the truncated list.
 279    MINSIZE and MAXSIZE are the limits on size allowed, as described below.
 280    In practice, these are the values of undo-limit and
 281    undo-strong-limit.  */
 282
 283 Lisp_Object
 284 truncate_undo_list (list, minsize, maxsize)
 285      Lisp_Object list;
 286      int minsize, maxsize;
 287 {
 288   Lisp_Object prev, next, last_boundary;
 289   int size_so_far = 0;
 290
 291   prev = Qnil;
 292   next = list;
 293   last_boundary = Qnil;
 294
 295   /* Always preserve at least the most recent undo record.
 296      If the first element is an undo boundary, skip past it.
 297
 298      Skip, skip, skip the undo, skip, skip, skip the undo,
 299      Skip, skip, skip the undo, skip to the undo bound'ry.
 300      (Get it?  "Skip to my Loo?")  */
 301   if (CONSP (next) && NILP (XCAR (next)))
 302     {
 303       /* Add in the space occupied by this element and its chain link.  */
 304       size_so_far += sizeof (struct Lisp_Cons);
 305
 306       /* Advance to next element.  */
 307       prev = next;
 308       next = XCDR (next);
 309     }
 310   while (CONSP (next) && ! NILP (XCAR (next)))
 311     {
 312       Lisp_Object elt;
 313       elt = 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       if (CONSP (elt))
 318         {
 319           size_so_far += sizeof (struct Lisp_Cons);
 320           if (STRINGP (XCAR (elt)))
 321             size_so_far += (sizeof (struct Lisp_String) - 1
 322                             + XSTRING (XCAR (elt))->size);
 323         }
 324
 325       /* Advance to next element.  */
 326       prev = next;
 327       next = XCDR (next);
 328     }
 329   if (CONSP (next))
 330     last_boundary = prev;
 331
 332   while (CONSP (next))
 333     {
 334       Lisp_Object elt;
 335       elt = XCAR (next);
 336
 337       /* When we get to a boundary, decide whether to truncate
 338          either before or after it.  The lower threshold, MINSIZE,
 339          tells us to truncate after it.  If its size pushes past
 340          the higher threshold MAXSIZE as well, we truncate before it.  */
 341       if (NILP (elt))
 342         {
 343           if (size_so_far > maxsize)
 344             break;
 345           last_boundary = prev;
 346           if (size_so_far > minsize)
 347             break;
 348         }
 349
 350       /* Add in the space occupied by this element and its chain link.  */
 351       size_so_far += sizeof (struct Lisp_Cons);
 352       if (CONSP (elt))
 353         {
 354           size_so_far += sizeof (struct Lisp_Cons);
 355           if (STRINGP (XCAR (elt)))
 356             size_so_far += (sizeof (struct Lisp_String) - 1
 357                             + XSTRING (XCAR (elt))->size);
 358         }
 359
 360       /* Advance to next element.  */
 361       prev = next;
 362       next = XCDR (next);
 363     }
 364
 365   /* If we scanned the whole list, it is short enough; don't change it.  */
 366   if (NILP (next))
 367     return list;
 368
 369   /* Truncate at the boundary where we decided to truncate.  */
 370   if (!NILP (last_boundary))
 371     {
 372       XCDR (last_boundary) = Qnil;
 373       return list;
 374     }
 375   else
 376     return Qnil;
 377 }
 378 \f
 379 DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0,
 380   "Undo N records from the front of the list LIST.\n\
 381 Return what remains of the list.")
 382   (n, list)
 383      Lisp_Object n, list;
 384 {
 385   struct gcpro gcpro1, gcpro2;
 386   Lisp_Object next;
 387   int count = specpdl_ptr - specpdl;
 388   register int arg;
 389 #if 0  /* This is a good feature, but would make undo-start
 390           unable to do what is expected.  */
 391   Lisp_Object tem;
 392
 393   /* If the head of the list is a boundary, it is the boundary
 394      preceding this command.  Get rid of it and don't count it.  */
 395   tem = Fcar (list);
 396   if (NILP (tem))
 397     list = Fcdr (list);
 398 #endif
 399
 400   CHECK_NUMBER (n, 0);
 401   arg = XINT (n);
 402   next = Qnil;
 403   GCPRO2 (next, list);
 404
 405   /* Don't let read-only properties interfere with undo.  */
 406   if (NILP (current_buffer->read_only))
 407     specbind (Qinhibit_read_only, Qt);
 408
 409   while (arg > 0)
 410     {
 411       while (1)
 412         {
 413           next = Fcar (list);
 414           list = Fcdr (list);
 415           /* Exit inner loop at undo boundary.  */
 416           if (NILP (next))
 417             break;
 418           /* Handle an integer by setting point to that value.  */
 419           if (INTEGERP (next))
 420             SET_PT (clip_to_bounds (BEGV, XINT (next), ZV));
 421           else if (CONSP (next))
 422             {
 423               Lisp_Object car, cdr;
 424
 425               car = Fcar (next);
 426               cdr = Fcdr (next);
 427               if (EQ (car, Qt))
 428                 {
 429                   /* Element (t high . low) records previous modtime.  */
 430                   Lisp_Object high, low;
 431                   int mod_time;
 432                   struct buffer *base_buffer = current_buffer;
 433
 434                   high = Fcar (cdr);
 435                   low = Fcdr (cdr);
 436                   mod_time = (XFASTINT (high) << 16) + XFASTINT (low);
 437
 438                   if (current_buffer->base_buffer)
 439                     base_buffer = current_buffer->base_buffer;
 440
 441                   /* If this records an obsolete save
 442                      (not matching the actual disk file)
 443                      then don't mark unmodified.  */
 444                   if (mod_time != base_buffer->modtime)
 445                     continue;
 446 #ifdef CLASH_DETECTION
 447                   Funlock_buffer ();
 448 #endif /* CLASH_DETECTION */
 449                   Fset_buffer_modified_p (Qnil);
 450                 }
 451 #ifdef USE_TEXT_PROPERTIES
 452               else if (EQ (car, Qnil))
 453                 {
 454                   /* Element (nil prop val beg . end) is property change.  */
 455                   Lisp_Object beg, end, prop, val;
 456
 457                   prop = Fcar (cdr);
 458                   cdr = Fcdr (cdr);
 459                   val = Fcar (cdr);
 460                   cdr = Fcdr (cdr);
 461                   beg = Fcar (cdr);
 462                   end = Fcdr (cdr);
 463
 464                   Fput_text_property (beg, end, prop, val, Qnil);
 465                 }
 466 #endif /* USE_TEXT_PROPERTIES */
 467               else if (INTEGERP (car) && INTEGERP (cdr))
 468                 {
 469                   /* Element (BEG . END) means range was inserted.  */
 470                   Lisp_Object end;
 471
 472                   if (XINT (car) < BEGV
 473                       || XINT (cdr) > ZV)
 474                     error ("Changes to be undone are outside visible portion of buffer");
 475                   /* Set point first thing, so that undoing this undo
 476                      does not send point back to where it is now.  */
 477                   Fgoto_char (car);
 478                   Fdelete_region (car, cdr);
 479                 }
 480               else if (STRINGP (car) && INTEGERP (cdr))
 481                 {
 482                   /* Element (STRING . POS) means STRING was deleted.  */
 483                   Lisp_Object membuf;
 484                   int pos = XINT (cdr);
 485
 486                   membuf = car;
 487                   if (pos < 0)
 488                     {
 489                       if (-pos < BEGV || -pos > ZV)
 490                         error ("Changes to be undone are outside visible portion of buffer");
 491                       SET_PT (-pos);
 492                       Finsert (1, &membuf);
 493                     }
 494                   else
 495                     {
 496                       if (pos < BEGV || pos > ZV)
 497                         error ("Changes to be undone are outside visible portion of buffer");
 498                       SET_PT (pos);
 499
 500                       /* Now that we record marker adjustments
 501                          (caused by deletion) for undo,
 502                          we should always insert after markers,
 503                          so that undoing the marker adjustments
 504                          put the markers back in the right place.  */
 505                       Finsert (1, &membuf);
 506                       SET_PT (pos);
 507                     }
 508                 }
 509               else if (MARKERP (car) && INTEGERP (cdr))
 510                 {
 511                   /* (MARKER . INTEGER) means a marker MARKER
 512                      was adjusted by INTEGER.  */
 513                   if (XMARKER (car)->buffer)
 514                     Fset_marker (car,
 515                                  make_number (marker_position (car) - XINT (cdr)),
 516                                  Fmarker_buffer (car));
 517                 }
 518             }
 519         }
 520       arg--;
 521     }
 522
 523   UNGCPRO;
 524   return unbind_to (count, list);
 525 }
 526
 527 void
 528 syms_of_undo ()
 529 {
 530   Qinhibit_read_only = intern ("inhibit-read-only");
 531   staticpro (&Qinhibit_read_only);
 532
 533   pending_boundary = Qnil;
 534   staticpro (&pending_boundary);
 535
 536   defsubr (&Sprimitive_undo);
 537   defsubr (&Sundo_boundary);
 538 }