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 = BINDING_STACK_SIZE ();
 397   register int arg;
 398
 399 #if 0  /* This is a good feature, but would make undo-start
 400           unable to do what is expected.  */
 401   Lisp_Object tem;
 402
 403   /* If the head of the list is a boundary, it is the boundary
 404      preceding this command.  Get rid of it and don't count it.  */
 405   tem = Fcar (list);
 406   if (NILP (tem))
 407     list = Fcdr (list);
 408 #endif
 409
 410   CHECK_NUMBER (n, 0);
 411   arg = XINT (n);
 412   next = Qnil;
 413   GCPRO2 (next, list);
 414
 415   /* In a writable buffer, enable undoing read-only text that is so
 416      because of text properties.  */
 417   if (NILP (current_buffer->read_only))
 418     specbind (Qinhibit_read_only, Qt);
 419
 420   /* Don't let `intangible' properties interfere with undo.  */
 421   specbind (Qinhibit_point_motion_hooks, Qt);
 422
 423   while (arg > 0)
 424     {
 425       while (1)
 426         {
 427           next = Fcar (list);
 428           list = Fcdr (list);
 429           /* Exit inner loop at undo boundary.  */
 430           if (NILP (next))
 431             break;
 432           /* Handle an integer by setting point to that value.  */
 433           if (INTEGERP (next))
 434             SET_PT (clip_to_bounds (BEGV, XINT (next), ZV));
 435           else if (CONSP (next))
 436             {
 437               Lisp_Object car, cdr;
 438
 439               car = Fcar (next);
 440               cdr = Fcdr (next);
 441               if (EQ (car, Qt))
 442                 {
 443                   /* Element (t high . low) records previous modtime.  */
 444                   Lisp_Object high, low;
 445                   int mod_time;
 446                   struct buffer *base_buffer = current_buffer;
 447
 448                   high = Fcar (cdr);
 449                   low = Fcdr (cdr);
 450                   mod_time = (XFASTINT (high) << 16) + XFASTINT (low);
 451
 452                   if (current_buffer->base_buffer)
 453                     base_buffer = current_buffer->base_buffer;
 454
 455                   /* If this records an obsolete save
 456                      (not matching the actual disk file)
 457                      then don't mark unmodified.  */
 458                   if (mod_time != base_buffer->modtime)
 459                     continue;
 460 #ifdef CLASH_DETECTION
 461                   Funlock_buffer ();
 462 #endif /* CLASH_DETECTION */
 463                   Fset_buffer_modified_p (Qnil);
 464                 }
 465               else if (EQ (car, Qnil))
 466                 {
 467                   /* Element (nil prop val beg . end) is property change.  */
 468                   Lisp_Object beg, end, prop, val;
 469
 470                   prop = Fcar (cdr);
 471                   cdr = Fcdr (cdr);
 472                   val = Fcar (cdr);
 473                   cdr = Fcdr (cdr);
 474                   beg = Fcar (cdr);
 475                   end = Fcdr (cdr);
 476
 477                   Fput_text_property (beg, end, prop, val, Qnil);
 478                 }
 479               else if (INTEGERP (car) && INTEGERP (cdr))
 480                 {
 481                   /* Element (BEG . END) means range was inserted.  */
 482
 483                   if (XINT (car) < BEGV
 484                       || XINT (cdr) > ZV)
 485                     error ("Changes to be undone are outside visible portion of buffer");
 486                   /* Set point first thing, so that undoing this undo
 487                      does not send point back to where it is now.  */
 488                   Fgoto_char (car);
 489                   Fdelete_region (car, cdr);
 490                 }
 491               else if (STRINGP (car) && INTEGERP (cdr))
 492                 {
 493                   /* Element (STRING . POS) means STRING was deleted.  */
 494                   Lisp_Object membuf;
 495                   int pos = XINT (cdr);
 496
 497                   membuf = car;
 498                   if (pos < 0)
 499                     {
 500                       if (-pos < BEGV || -pos > ZV)
 501                         error ("Changes to be undone are outside visible portion of buffer");
 502                       SET_PT (-pos);
 503                       Finsert (1, &membuf);
 504                     }
 505                   else
 506                     {
 507                       if (pos < BEGV || pos > ZV)
 508                         error ("Changes to be undone are outside visible portion of buffer");
 509                       SET_PT (pos);
 510
 511                       /* Now that we record marker adjustments
 512                          (caused by deletion) for undo,
 513                          we should always insert after markers,
 514                          so that undoing the marker adjustments
 515                          put the markers back in the right place.  */
 516                       Finsert (1, &membuf);
 517                       SET_PT (pos);
 518                     }
 519                 }
 520               else if (MARKERP (car) && INTEGERP (cdr))
 521                 {
 522                   /* (MARKER . INTEGER) means a marker MARKER
 523                      was adjusted by INTEGER.  */
 524                   if (XMARKER (car)->buffer)
 525                     Fset_marker (car,
 526                                  make_number (marker_position (car) - XINT (cdr)),
 527                                  Fmarker_buffer (car));
 528                 }
 529             }
 530         }
 531       arg--;
 532     }
 533
 534   UNGCPRO;
 535   return unbind_to (count, list);
 536 }
 537
 538 void
 539 syms_of_undo ()
 540 {
 541   Qinhibit_read_only = intern ("inhibit-read-only");
 542   staticpro (&Qinhibit_read_only);
 543
 544   pending_boundary = Qnil;
 545   staticpro (&pending_boundary);
 546
 547   defsubr (&Sprimitive_undo);
 548   defsubr (&Sundo_boundary);
 549 }