src/undo.c

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