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