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               else if (EQ (car, Qnil))
 452                 {
 453                   /* Element (nil prop val beg . end) is property change.  */
 454                   Lisp_Object beg, end, prop, val;
 455
 456                   prop = Fcar (cdr);
 457                   cdr = Fcdr (cdr);
 458                   val = Fcar (cdr);
 459                   cdr = Fcdr (cdr);
 460                   beg = Fcar (cdr);
 461                   end = Fcdr (cdr);
 462
 463                   Fput_text_property (beg, end, prop, val, Qnil);
 464                 }
 465               else if (INTEGERP (car) && INTEGERP (cdr))
 466                 {
 467                   /* Element (BEG . END) means range was inserted.  */
 468                   Lisp_Object end;
 469
 470                   if (XINT (car) < BEGV
 471                       || XINT (cdr) > ZV)
 472                     error ("Changes to be undone are outside visible portion of buffer");
 473                   /* Set point first thing, so that undoing this undo
 474                      does not send point back to where it is now.  */
 475                   Fgoto_char (car);
 476                   Fdelete_region (car, cdr);
 477                 }
 478               else if (STRINGP (car) && INTEGERP (cdr))
 479                 {
 480                   /* Element (STRING . POS) means STRING was deleted.  */
 481                   Lisp_Object membuf;
 482                   int pos = XINT (cdr);
 483
 484                   membuf = car;
 485                   if (pos < 0)
 486                     {
 487                       if (-pos < BEGV || -pos > ZV)
 488                         error ("Changes to be undone are outside visible portion of buffer");
 489                       SET_PT (-pos);
 490                       Finsert (1, &membuf);
 491                     }
 492                   else
 493                     {
 494                       if (pos < BEGV || pos > ZV)
 495                         error ("Changes to be undone are outside visible portion of buffer");
 496                       SET_PT (pos);
 497
 498                       /* Now that we record marker adjustments
 499                          (caused by deletion) for undo,
 500                          we should always insert after markers,
 501                          so that undoing the marker adjustments
 502                          put the markers back in the right place.  */
 503                       Finsert (1, &membuf);
 504                       SET_PT (pos);
 505                     }
 506                 }
 507               else if (MARKERP (car) && INTEGERP (cdr))
 508                 {
 509                   /* (MARKER . INTEGER) means a marker MARKER
 510                      was adjusted by INTEGER.  */
 511                   if (XMARKER (car)->buffer)
 512                     Fset_marker (car,
 513                                  make_number (marker_position (car) - XINT (cdr)),
 514                                  Fmarker_buffer (car));
 515                 }
 516             }
 517         }
 518       arg--;
 519     }
 520
 521   UNGCPRO;
 522   return unbind_to (count, list);
 523 }
 524
 525 void
 526 syms_of_undo ()
 527 {
 528   Qinhibit_read_only = intern ("inhibit-read-only");
 529   staticpro (&Qinhibit_read_only);
 530
 531   pending_boundary = Qnil;
 532   staticpro (&pending_boundary);
 533
 534   defsubr (&Sprimitive_undo);
 535   defsubr (&Sundo_boundary);
 536 }