src/undo.c

   1 /* undo handling for GNU Emacs.
   2    Copyright (C) 1990, 1993 Free Software Foundation, Inc.
   3
   4 This file is part of GNU Emacs.
   5
   6 GNU Emacs is distributed in the hope that it will be useful,
   7 but WITHOUT ANY WARRANTY.  No author or distributor
   8 accepts responsibility to anyone for the consequences of using it
   9 or for whether it serves any particular purpose or works at all,
  10 unless he says so in writing.  Refer to the GNU Emacs General Public
  11 License for full details.
  12
  13 Everyone is granted permission to copy, modify and redistribute
  14 GNU Emacs, but only under the conditions described in the
  15 GNU Emacs General Public License.   A copy of this license is
  16 supposed to have been given to you along with GNU Emacs so you
  17 can know your rights and responsibilities.  It should be in a
  18 file named COPYING.  Among other things, the copyright notice
  19 and this notice must be preserved on all copies.  */
  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 record_insert (beg, length)
  45      Lisp_Object beg, length;
  46 {
  47   Lisp_Object lbeg, lend;
  48
  49   if (EQ (current_buffer->undo_list, Qt))
  50     return;
  51
  52   /* Allocate a cons cell to be the undo boundary after this command.  */
  53   if (NILP (pending_boundary))
  54     pending_boundary = Fcons (Qnil, Qnil);
  55
  56   if (current_buffer != XBUFFER (last_undo_buffer))
  57     Fundo_boundary ();
  58   XSET (last_undo_buffer, Lisp_Buffer, current_buffer);
  59
  60   if (MODIFF <= current_buffer->save_modified)
  61     record_first_change ();
  62
  63   /* If this is following another insertion and consecutive with it
  64      in the buffer, combine the two.  */
  65   if (XTYPE (current_buffer->undo_list) == Lisp_Cons)
  66     {
  67       Lisp_Object elt;
  68       elt = XCONS (current_buffer->undo_list)->car;
  69       if (XTYPE (elt) == Lisp_Cons
  70           && XTYPE (XCONS (elt)->car) == Lisp_Int
  71           && XTYPE (XCONS (elt)->cdr) == Lisp_Int
  72           && XINT (XCONS (elt)->cdr) == XINT (beg))
  73         {
  74           XSETINT (XCONS (elt)->cdr, XINT (beg) + XINT (length));
  75           return;
  76         }
  77     }
  78
  79   lbeg = beg;
  80   XSET (lend, Lisp_Int, XINT (beg) + XINT (length));
  81   current_buffer->undo_list = Fcons (Fcons (lbeg, lend),
  82                                      current_buffer->undo_list);
  83 }
  84
  85 /* Record that a deletion is about to take place,
  86    for LENGTH characters at location BEG.  */
  87
  88 record_delete (beg, length)
  89      int beg, length;
  90 {
  91   Lisp_Object lbeg, lend, sbeg;
  92
  93   if (EQ (current_buffer->undo_list, Qt))
  94     return;
  95
  96   /* Allocate a cons cell to be the undo boundary after this command.  */
  97   if (NILP (pending_boundary))
  98     pending_boundary = Fcons (Qnil, Qnil);
  99
 100   if (current_buffer != XBUFFER (last_undo_buffer))
 101     Fundo_boundary ();
 102   XSET (last_undo_buffer, Lisp_Buffer, current_buffer);
 103
 104   if (MODIFF <= current_buffer->save_modified)
 105     record_first_change ();
 106
 107   if (point == beg + length)
 108     XSET (sbeg, Lisp_Int, -beg);
 109   else
 110     XFASTINT (sbeg) = beg;
 111   XFASTINT (lbeg) = beg;
 112   XFASTINT (lend) = beg + length;
 113
 114   /* If point wasn't at start of deleted range, record where it was.  */
 115   if (last_point_position != XFASTINT (sbeg))
 116     current_buffer->undo_list
 117       = Fcons (make_number (last_point_position), current_buffer->undo_list);
 118
 119   current_buffer->undo_list
 120     = Fcons (Fcons (Fbuffer_substring (lbeg, lend), sbeg),
 121              current_buffer->undo_list);
 122 }
 123
 124 /* Record that a replacement is about to take place,
 125    for LENGTH characters at location BEG.
 126    The replacement does not change the number of characters.  */
 127
 128 record_change (beg, length)
 129      int beg, length;
 130 {
 131   record_delete (beg, length);
 132   record_insert (beg, length);
 133 }
 134 \f
 135 /* Record that an unmodified buffer is about to be changed.
 136    Record the file modification date so that when undoing this entry
 137    we can tell whether it is obsolete because the file was saved again.  */
 138
 139 record_first_change ()
 140 {
 141   Lisp_Object high, low;
 142
 143   if (EQ (current_buffer->undo_list, Qt))
 144     return;
 145
 146   if (current_buffer != XBUFFER (last_undo_buffer))
 147     Fundo_boundary ();
 148   XSET (last_undo_buffer, Lisp_Buffer, current_buffer);
 149
 150   XFASTINT (high) = (current_buffer->modtime >> 16) & 0xffff;
 151   XFASTINT (low) = current_buffer->modtime & 0xffff;
 152   current_buffer->undo_list = Fcons (Fcons (Qt, Fcons (high, low)), current_buffer->undo_list);
 153 }
 154
 155 /* Record a change in property PROP (whose old value was VAL)
 156    for LENGTH characters starting at position BEG in BUFFER.  */
 157
 158 record_property_change (beg, length, prop, value, buffer)
 159      int beg, length;
 160      Lisp_Object prop, value, buffer;
 161 {
 162   Lisp_Object lbeg, lend, entry;
 163   struct buffer *obuf = current_buffer;
 164   int boundary = 0;
 165
 166   if (EQ (XBUFFER (buffer)->undo_list, Qt))
 167     return;
 168
 169   /* Allocate a cons cell to be the undo boundary after this command.  */
 170   if (NILP (pending_boundary))
 171     pending_boundary = Fcons (Qnil, Qnil);
 172
 173   if (!EQ (buffer, last_undo_buffer))
 174     boundary = 1;
 175   last_undo_buffer = buffer;
 176
 177   /* Switch temporarily to the buffer that was changed.  */
 178   current_buffer = XBUFFER (buffer);
 179
 180   if (boundary)
 181     Fundo_boundary ();
 182
 183   if (MODIFF <= current_buffer->save_modified)
 184     record_first_change ();
 185
 186   XSET (lbeg, Lisp_Int, beg);
 187   XSET (lend, Lisp_Int, beg + length);
 188   entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend))));
 189   current_buffer->undo_list = Fcons (entry, current_buffer->undo_list);
 190
 191   current_buffer = obuf;
 192 }
 193
 194 DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0,
 195   "Mark a boundary between units of undo.\n\
 196 An undo command will stop at this point,\n\
 197 but another undo command will undo to the previous boundary.")
 198   ()
 199 {
 200   Lisp_Object tem;
 201   if (EQ (current_buffer->undo_list, Qt))
 202     return Qnil;
 203   tem = Fcar (current_buffer->undo_list);
 204   if (!NILP (tem))
 205     {
 206       /* One way or another, cons nil onto the front of the undo list.  */
 207       if (!NILP (pending_boundary))
 208         {
 209           /* If we have preallocated the cons cell to use here,
 210              use that one.  */
 211           XCONS (pending_boundary)->cdr = current_buffer->undo_list;
 212           current_buffer->undo_list = pending_boundary;
 213           pending_boundary = Qnil;
 214         }
 215       else
 216         current_buffer->undo_list = Fcons (Qnil, current_buffer->undo_list);
 217     }
 218   return Qnil;
 219 }
 220
 221 /* At garbage collection time, make an undo list shorter at the end,
 222    returning the truncated list.
 223    MINSIZE and MAXSIZE are the limits on size allowed, as described below.
 224    In practice, these are the values of undo-limit and
 225    undo-strong-limit.  */
 226
 227 Lisp_Object
 228 truncate_undo_list (list, minsize, maxsize)
 229      Lisp_Object list;
 230      int minsize, maxsize;
 231 {
 232   Lisp_Object prev, next, last_boundary;
 233   int size_so_far = 0;
 234
 235   prev = Qnil;
 236   next = list;
 237   last_boundary = Qnil;
 238
 239   /* Always preserve at least the most recent undo record.
 240      If the first element is an undo boundary, skip past it.
 241
 242      Skip, skip, skip the undo, skip, skip, skip the undo,
 243      Skip, skip, skip the undo, skip to the undo bound'ry.
 244      (Get it?  "Skip to my Loo?")  */
 245   if (XTYPE (next) == Lisp_Cons
 246       && NILP (XCONS (next)->car))
 247     {
 248       /* Add in the space occupied by this element and its chain link.  */
 249       size_so_far += sizeof (struct Lisp_Cons);
 250
 251       /* Advance to next element.  */
 252       prev = next;
 253       next = XCONS (next)->cdr;
 254     }
 255   while (XTYPE (next) == Lisp_Cons
 256          && ! NILP (XCONS (next)->car))
 257     {
 258       Lisp_Object elt;
 259       elt = XCONS (next)->car;
 260
 261       /* Add in the space occupied by this element and its chain link.  */
 262       size_so_far += sizeof (struct Lisp_Cons);
 263       if (XTYPE (elt) == Lisp_Cons)
 264         {
 265           size_so_far += sizeof (struct Lisp_Cons);
 266           if (XTYPE (XCONS (elt)->car) == Lisp_String)
 267             size_so_far += (sizeof (struct Lisp_String) - 1
 268                             + XSTRING (XCONS (elt)->car)->size);
 269         }
 270
 271       /* Advance to next element.  */
 272       prev = next;
 273       next = XCONS (next)->cdr;
 274     }
 275   if (XTYPE (next) == Lisp_Cons)
 276     last_boundary = prev;
 277
 278   while (XTYPE (next) == Lisp_Cons)
 279     {
 280       Lisp_Object elt;
 281       elt = XCONS (next)->car;
 282
 283       /* When we get to a boundary, decide whether to truncate
 284          either before or after it.  The lower threshold, MINSIZE,
 285          tells us to truncate after it.  If its size pushes past
 286          the higher threshold MAXSIZE as well, we truncate before it.  */
 287       if (NILP (elt))
 288         {
 289           if (size_so_far > maxsize)
 290             break;
 291           last_boundary = prev;
 292           if (size_so_far > minsize)
 293             break;
 294         }
 295
 296       /* Add in the space occupied by this element and its chain link.  */
 297       size_so_far += sizeof (struct Lisp_Cons);
 298       if (XTYPE (elt) == Lisp_Cons)
 299         {
 300           size_so_far += sizeof (struct Lisp_Cons);
 301           if (XTYPE (XCONS (elt)->car) == Lisp_String)
 302             size_so_far += (sizeof (struct Lisp_String) - 1
 303                             + XSTRING (XCONS (elt)->car)->size);
 304         }
 305
 306       /* Advance to next element.  */
 307       prev = next;
 308       next = XCONS (next)->cdr;
 309     }
 310
 311   /* If we scanned the whole list, it is short enough; don't change it.  */
 312   if (NILP (next))
 313     return list;
 314
 315   /* Truncate at the boundary where we decided to truncate.  */
 316   if (!NILP (last_boundary))
 317     {
 318       XCONS (last_boundary)->cdr = Qnil;
 319       return list;
 320     }
 321   else
 322     return Qnil;
 323 }
 324 \f
 325 DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0,
 326   "Undo N records from the front of the list LIST.\n\
 327 Return what remains of the list.")
 328   (n, list)
 329      Lisp_Object n, list;
 330 {
 331   int count = specpdl_ptr - specpdl;
 332   register int arg = XINT (n);
 333 #if 0  /* This is a good feature, but would make undo-start
 334           unable to do what is expected.  */
 335   Lisp_Object tem;
 336
 337   /* If the head of the list is a boundary, it is the boundary
 338      preceding this command.  Get rid of it and don't count it.  */
 339   tem = Fcar (list);
 340   if (NILP (tem))
 341     list = Fcdr (list);
 342 #endif
 343
 344   /* Don't let read-only properties interfere with undo.  */
 345   if (NILP (current_buffer->read_only))
 346     specbind (Qinhibit_read_only, Qt);
 347
 348   while (arg > 0)
 349     {
 350       while (1)
 351         {
 352           Lisp_Object next;
 353           next = Fcar (list);
 354           list = Fcdr (list);
 355           /* Exit inner loop at undo boundary.  */
 356           if (NILP (next))
 357             break;
 358           /* Handle an integer by setting point to that value.  */
 359           if (XTYPE (next) == Lisp_Int)
 360             SET_PT (clip_to_bounds (BEGV, XINT (next), ZV));
 361           else if (XTYPE (next) == Lisp_Cons)
 362             {
 363               Lisp_Object car, cdr;
 364
 365               car = Fcar (next);
 366               cdr = Fcdr (next);
 367               if (EQ (car, Qt))
 368                 {
 369                   /* Element (t high . low) records previous modtime.  */
 370                   Lisp_Object high, low;
 371                   int mod_time;
 372
 373                   high = Fcar (cdr);
 374                   low = Fcdr (cdr);
 375                   mod_time = (XFASTINT (high) << 16) + XFASTINT (low);
 376                   /* If this records an obsolete save
 377                      (not matching the actual disk file)
 378                      then don't mark unmodified.  */
 379                   if (mod_time != current_buffer->modtime)
 380                     break;
 381 #ifdef CLASH_DETECTION
 382                   Funlock_buffer ();
 383 #endif /* CLASH_DETECTION */
 384                   Fset_buffer_modified_p (Qnil);
 385                 }
 386 #ifdef USE_TEXT_PROPERTIES
 387               else if (EQ (car, Qnil))
 388                 {
 389                   /* Element (nil prop val beg . end) is property change.  */
 390                   Lisp_Object beg, end, prop, val;
 391
 392                   prop = Fcar (cdr);
 393                   cdr = Fcdr (cdr);
 394                   val = Fcar (cdr);
 395                   cdr = Fcdr (cdr);
 396                   beg = Fcar (cdr);
 397                   end = Fcdr (cdr);
 398
 399                   Fput_text_property (beg, end, prop, val, Qnil);
 400                 }
 401 #endif /* USE_TEXT_PROPERTIES */
 402               else if (XTYPE (car) == Lisp_Int && XTYPE (cdr) == Lisp_Int)
 403                 {
 404                   /* Element (BEG . END) means range was inserted.  */
 405                   Lisp_Object end;
 406
 407                   if (XINT (car) < BEGV
 408                       || XINT (cdr) > ZV)
 409                     error ("Changes to be undone are outside visible portion of buffer");
 410                   /* Set point first thing, so that undoing this undo
 411                      does not send point back to where it is now.  */
 412                   Fgoto_char (car);
 413                   Fdelete_region (car, cdr);
 414                 }
 415               else if (XTYPE (car) == Lisp_String && XTYPE (cdr) == Lisp_Int)
 416                 {
 417                   /* Element (STRING . POS) means STRING was deleted.  */
 418                   Lisp_Object membuf;
 419                   int pos = XINT (cdr);
 420
 421                   membuf = car;
 422                   if (pos < 0)
 423                     {
 424                       if (-pos < BEGV || -pos > ZV)
 425                         error ("Changes to be undone are outside visible portion of buffer");
 426                       SET_PT (-pos);
 427                       Finsert (1, &membuf);
 428                     }
 429                   else
 430                     {
 431                       if (pos < BEGV || pos > ZV)
 432                         error ("Changes to be undone are outside visible portion of buffer");
 433                       SET_PT (pos);
 434
 435                       /* Insert before markers so that if the mark is
 436                          currently on the boundary of this deletion, it
 437                          ends up on the other side of the now-undeleted
 438                          text from point.  Since undo doesn't even keep
 439                          track of the mark, this isn't really necessary,
 440                          but it may lead to better behavior in certain
 441                          situations.  */
 442                       Finsert_before_markers (1, &membuf);
 443                       SET_PT (pos);
 444                     }
 445                 }
 446             }
 447         }
 448       arg--;
 449     }
 450
 451   return unbind_to (count, list);
 452 }
 453
 454 syms_of_undo ()
 455 {
 456   Qinhibit_read_only = intern ("inhibit-read-only");
 457   staticpro (&Qinhibit_read_only);
 458
 459   pending_boundary = Qnil;
 460   staticpro (&pending_boundary);
 461
 462   defsubr (&Sprimitive_undo);
 463   defsubr (&Sundo_boundary);
 464 }