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