src/undo.c

   1 /* undo handling for GNU Emacs.
   2    Copyright (C) 1990 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
  26 /* Last buffer for which undo information was recorded.  */
  27 Lisp_Object last_undo_buffer;
  28
  29 /* Record an insertion that just happened or is about to happen,
  30    for LENGTH characters at position BEG.
  31    (It is possible to record an insertion before or after the fact
  32    because we don't need to record the contents.)  */
  33
  34 record_insert (beg, length)
  35      Lisp_Object beg, length;
  36 {
  37   Lisp_Object lbeg, lend;
  38
  39   if (EQ (current_buffer->undo_list, Qt))
  40     return;
  41
  42   if (current_buffer != XBUFFER (last_undo_buffer))
  43     Fundo_boundary ();
  44   XSET (last_undo_buffer, Lisp_Buffer, current_buffer);
  45
  46   if (MODIFF <= current_buffer->save_modified)
  47     record_first_change ();
  48
  49   /* If this is following another insertion and consecutive with it
  50      in the buffer, combine the two.  */
  51   if (XTYPE (current_buffer->undo_list) == Lisp_Cons)
  52     {
  53       Lisp_Object elt;
  54       elt = XCONS (current_buffer->undo_list)->car;
  55       if (XTYPE (elt) == Lisp_Cons
  56           && XTYPE (XCONS (elt)->car) == Lisp_Int
  57           && XTYPE (XCONS (elt)->cdr) == Lisp_Int
  58           && XINT (XCONS (elt)->cdr) == XINT (beg))
  59         {
  60           XSETINT (XCONS (elt)->cdr, XINT (beg) + XINT (length));
  61           return;
  62         }
  63     }
  64
  65   lbeg = beg;
  66   XSET (lend, Lisp_Int, XINT (beg) + XINT (length));
  67   current_buffer->undo_list = Fcons (Fcons (lbeg, lend),
  68                                      current_buffer->undo_list);
  69 }
  70
  71 /* Record that a deletion is about to take place,
  72    for LENGTH characters at location BEG.  */
  73
  74 record_delete (beg, length)
  75      int beg, length;
  76 {
  77   Lisp_Object lbeg, lend, sbeg;
  78
  79   if (EQ (current_buffer->undo_list, Qt))
  80     return;
  81
  82   if (current_buffer != XBUFFER (last_undo_buffer))
  83     Fundo_boundary ();
  84   XSET (last_undo_buffer, Lisp_Buffer, current_buffer);
  85
  86   if (MODIFF <= current_buffer->save_modified)
  87     record_first_change ();
  88
  89   if (point == beg + length)
  90     XSET (sbeg, Lisp_Int, -beg);
  91   else
  92     XFASTINT (sbeg) = beg;
  93   XFASTINT (lbeg) = beg;
  94   XFASTINT (lend) = beg + length;
  95
  96   /* If point isn't at start of deleted range, record where it is.  */
  97   if (PT != sbeg)
  98     current_buffer->undo_list
  99       = Fcons (make_number (PT), current_buffer->undo_list);
 100
 101   current_buffer->undo_list
 102     = Fcons (Fcons (Fbuffer_substring (lbeg, lend), sbeg),
 103              current_buffer->undo_list);
 104 }
 105
 106 /* Record that a replacement is about to take place,
 107    for LENGTH characters at location BEG.
 108    The replacement does not change the number of characters.  */
 109
 110 record_change (beg, length)
 111      int beg, length;
 112 {
 113   record_delete (beg, length);
 114   record_insert (beg, length);
 115 }
 116 \f
 117 /* Record that an unmodified buffer is about to be changed.
 118    Record the file modification date so that when undoing this entry
 119    we can tell whether it is obsolete because the file was saved again.  */
 120
 121 record_first_change ()
 122 {
 123   Lisp_Object high, low;
 124   XFASTINT (high) = (current_buffer->modtime >> 16) & 0xffff;
 125   XFASTINT (low) = current_buffer->modtime & 0xffff;
 126   current_buffer->undo_list = Fcons (Fcons (Qt, Fcons (high, low)), current_buffer->undo_list);
 127 }
 128
 129 /* Record a change in property PROP (whose old value was VAL)
 130    for LENGTH characters starting at position BEG in BUFFER.  */
 131
 132 record_property_change (beg, length, prop, value, buffer)
 133      int beg, length;
 134      Lisp_Object prop, value, buffer;
 135 {
 136   Lisp_Object lbeg, lend, entry;
 137   struct buffer *obuf = current_buffer;
 138   int boundary = 0;
 139
 140   if (EQ (current_buffer->undo_list, Qt))
 141     return;
 142
 143   if (!EQ (buffer, last_undo_buffer))
 144     boundary = 1;
 145   last_undo_buffer = buffer;
 146
 147   /* Switch temporarily to the buffer that was changed.  */
 148   current_buffer = XBUFFER (buffer);
 149
 150   if (boundary)
 151     Fundo_boundary ();
 152
 153   if (MODIFF <= current_buffer->save_modified)
 154     record_first_change ();
 155
 156   XSET (lbeg, Lisp_Int, beg);
 157   XSET (lend, Lisp_Int, beg + length);
 158   entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend))));
 159   current_buffer->undo_list = Fcons (entry, current_buffer->undo_list);
 160
 161   current_buffer = obuf;
 162 }
 163
 164 DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0,
 165   "Mark a boundary between units of undo.\n\
 166 An undo command will stop at this point,\n\
 167 but another undo command will undo to the previous boundary.")
 168   ()
 169 {
 170   Lisp_Object tem;
 171   if (EQ (current_buffer->undo_list, Qt))
 172     return Qnil;
 173   tem = Fcar (current_buffer->undo_list);
 174   if (!NILP (tem))
 175     current_buffer->undo_list = Fcons (Qnil, current_buffer->undo_list);
 176   return Qnil;
 177 }
 178
 179 /* At garbage collection time, make an undo list shorter at the end,
 180    returning the truncated list.
 181    MINSIZE and MAXSIZE are the limits on size allowed, as described below.
 182    In practice, these are the values of undo-limit and
 183    undo-strong-limit.  */
 184
 185 Lisp_Object
 186 truncate_undo_list (list, minsize, maxsize)
 187      Lisp_Object list;
 188      int minsize, maxsize;
 189 {
 190   Lisp_Object prev, next, last_boundary;
 191   int size_so_far = 0;
 192
 193   prev = Qnil;
 194   next = list;
 195   last_boundary = Qnil;
 196
 197   /* Always preserve at least the most recent undo record.
 198      If the first element is an undo boundary, skip past it.
 199
 200      Skip, skip, skip the undo, skip, skip, skip the undo,
 201      Skip, skip, skip the undo, skip to the undo bound'ry.
 202      (Get it?  "Skip to my Loo?")  */
 203   if (XTYPE (next) == Lisp_Cons
 204       && NILP (XCONS (next)->car))
 205     {
 206       /* Add in the space occupied by this element and its chain link.  */
 207       size_so_far += sizeof (struct Lisp_Cons);
 208
 209       /* Advance to next element.  */
 210       prev = next;
 211       next = XCONS (next)->cdr;
 212     }
 213   while (XTYPE (next) == Lisp_Cons
 214          && ! NILP (XCONS (next)->car))
 215     {
 216       Lisp_Object elt;
 217       elt = XCONS (next)->car;
 218
 219       /* Add in the space occupied by this element and its chain link.  */
 220       size_so_far += sizeof (struct Lisp_Cons);
 221       if (XTYPE (elt) == Lisp_Cons)
 222         {
 223           size_so_far += sizeof (struct Lisp_Cons);
 224           if (XTYPE (XCONS (elt)->car) == Lisp_String)
 225             size_so_far += (sizeof (struct Lisp_String) - 1
 226                             + XSTRING (XCONS (elt)->car)->size);
 227         }
 228
 229       /* Advance to next element.  */
 230       prev = next;
 231       next = XCONS (next)->cdr;
 232     }
 233   if (XTYPE (next) == Lisp_Cons)
 234     last_boundary = prev;
 235
 236   while (XTYPE (next) == Lisp_Cons)
 237     {
 238       Lisp_Object elt;
 239       elt = XCONS (next)->car;
 240
 241       /* When we get to a boundary, decide whether to truncate
 242          either before or after it.  The lower threshold, MINSIZE,
 243          tells us to truncate after it.  If its size pushes past
 244          the higher threshold MAXSIZE as well, we truncate before it.  */
 245       if (NILP (elt))
 246         {
 247           if (size_so_far > maxsize)
 248             break;
 249           last_boundary = prev;
 250           if (size_so_far > minsize)
 251             break;
 252         }
 253
 254       /* Add in the space occupied by this element and its chain link.  */
 255       size_so_far += sizeof (struct Lisp_Cons);
 256       if (XTYPE (elt) == Lisp_Cons)
 257         {
 258           size_so_far += sizeof (struct Lisp_Cons);
 259           if (XTYPE (XCONS (elt)->car) == Lisp_String)
 260             size_so_far += (sizeof (struct Lisp_String) - 1
 261                             + XSTRING (XCONS (elt)->car)->size);
 262         }
 263
 264       /* Advance to next element.  */
 265       prev = next;
 266       next = XCONS (next)->cdr;
 267     }
 268
 269   /* If we scanned the whole list, it is short enough; don't change it.  */
 270   if (NILP (next))
 271     return list;
 272
 273   /* Truncate at the boundary where we decided to truncate.  */
 274   if (!NILP (last_boundary))
 275     {
 276       XCONS (last_boundary)->cdr = Qnil;
 277       return list;
 278     }
 279   else
 280     return Qnil;
 281 }
 282 \f
 283 DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0,
 284   "Undo N records from the front of the list LIST.\n\
 285 Return what remains of the list.")
 286   (count, list)
 287      Lisp_Object count, list;
 288 {
 289   register int arg = XINT (count);
 290 #if 0  /* This is a good feature, but would make undo-start
 291           unable to do what is expected.  */
 292   Lisp_Object tem;
 293
 294   /* If the head of the list is a boundary, it is the boundary
 295      preceding this command.  Get rid of it and don't count it.  */
 296   tem = Fcar (list);
 297   if (NILP (tem))
 298     list = Fcdr (list);
 299 #endif
 300
 301   while (arg > 0)
 302     {
 303       while (1)
 304         {
 305           Lisp_Object next;
 306           next = Fcar (list);
 307           list = Fcdr (list);
 308           /* Exit inner loop at undo boundary.  */
 309           if (NILP (next))
 310             break;
 311           /* Handle an integer by setting point to that value.  */
 312           if (XTYPE (next) == Lisp_Int)
 313             SET_PT (clip_to_bounds (BEGV, XINT (next), ZV));
 314           else if (XTYPE (next) == Lisp_Cons)
 315             {
 316               Lisp_Object car, cdr;
 317
 318               car = Fcar (next);
 319               cdr = Fcdr (next);
 320               if (EQ (car, Qt))
 321                 {
 322                   /* Element (t high . low) records previous modtime.  */
 323                   Lisp_Object high, low;
 324                   int mod_time;
 325
 326                   high = Fcar (cdr);
 327                   low = Fcdr (cdr);
 328                   mod_time = (high << 16) + low;
 329                   /* If this records an obsolete save
 330                      (not matching the actual disk file)
 331                      then don't mark unmodified.  */
 332                   if (mod_time != current_buffer->modtime)
 333                     break;
 334 #ifdef CLASH_DETECTION
 335                   Funlock_buffer ();
 336 #endif /* CLASH_DETECTION */
 337                   Fset_buffer_modified_p (Qnil);
 338                 }
 339               if (EQ (car, Qnil))
 340                 {
 341                   /* Element (t prop val beg . end) records property change.  */
 342                   Lisp_Object beg, end, prop, val;
 343
 344                   prop = Fcar (cdr);
 345                   cdr = Fcdr (cdr);
 346                   val = Fcar (cdr);
 347                   cdr = Fcdr (cdr);
 348                   beg = Fcar (cdr);
 349                   end = Fcdr (cdr);
 350
 351                   Fput_text_property (beg, end, prop, val, Qnil);
 352                 }
 353               else if (XTYPE (car) == Lisp_Int && XTYPE (cdr) == Lisp_Int)
 354                 {
 355                   /* Element (BEG . END) means range was inserted.  */
 356                   Lisp_Object end;
 357
 358                   if (XINT (car) < BEGV
 359                       || XINT (cdr) > ZV)
 360                     error ("Changes to be undone are outside visible portion of buffer");
 361                   /* Set point first thing, so that undoing this undo
 362                      does not send point back to where it is now.  */
 363                   Fgoto_char (car);
 364                   Fdelete_region (car, cdr);
 365                 }
 366               else if (XTYPE (car) == Lisp_String && XTYPE (cdr) == Lisp_Int)
 367                 {
 368                   /* Element (STRING . POS) means STRING was deleted.  */
 369                   Lisp_Object membuf;
 370                   int pos = XINT (cdr);
 371
 372                   membuf = car;
 373                   if (pos < 0)
 374                     {
 375                       if (-pos < BEGV || -pos > ZV)
 376                         error ("Changes to be undone are outside visible portion of buffer");
 377                       SET_PT (-pos);
 378                       Finsert (1, &membuf);
 379                     }
 380                   else
 381                     {
 382                       if (pos < BEGV || pos > ZV)
 383                         error ("Changes to be undone are outside visible portion of buffer");
 384                       SET_PT (pos);
 385
 386                       /* Insert before markers so that if the mark is
 387                          currently on the boundary of this deletion, it
 388                          ends up on the other side of the now-undeleted
 389                          text from point.  Since undo doesn't even keep
 390                          track of the mark, this isn't really necessary,
 391                          but it may lead to better behavior in certain
 392                          situations.  */
 393                       Finsert_before_markers (1, &membuf);
 394                       SET_PT (pos);
 395                     }
 396                 }
 397             }
 398         }
 399       arg--;
 400     }
 401
 402   return list;
 403 }
 404
 405 syms_of_undo ()
 406 {
 407   defsubr (&Sprimitive_undo);
 408   defsubr (&Sundo_boundary);
 409 }