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