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