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