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-threshold and
 139    undo-high-threshold.  */
 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   if (XTYPE (next) == Lisp_Cons
 159       && XCONS (next)->car == Qnil)
 160     {
 161       /* Add in the space occupied by this element and its chain link.  */
 162       size_so_far += sizeof (struct Lisp_Cons);
 163
 164       /* Advance to next element.  */
 165       prev = next;
 166       next = XCONS (next)->cdr;
 167     }
 168   while (XTYPE (next) == Lisp_Cons
 169          && XCONS (next)->car != Qnil)
 170     {
 171       Lisp_Object elt;
 172       elt = XCONS (next)->car;
 173
 174       /* Add in the space occupied by this element and its chain link.  */
 175       size_so_far += sizeof (struct Lisp_Cons);
 176       if (XTYPE (elt) == Lisp_Cons)
 177         {
 178           size_so_far += sizeof (struct Lisp_Cons);
 179           if (XTYPE (XCONS (elt)->car) == Lisp_String)
 180             size_so_far += (sizeof (struct Lisp_String) - 1
 181                             + XSTRING (XCONS (elt)->car)->size);
 182         }
 183
 184       /* Advance to next element.  */
 185       prev = next;
 186       next = XCONS (next)->cdr;
 187     }
 188   if (XTYPE (next) == Lisp_Cons)
 189     last_boundary = prev;
 190
 191   while (XTYPE (next) == Lisp_Cons)
 192     {
 193       Lisp_Object elt;
 194       elt = XCONS (next)->car;
 195
 196       /* When we get to a boundary, decide whether to truncate
 197          either before or after it.  The lower threshold, MINSIZE,
 198          tells us to truncate after it.  If its size pushes past
 199          the higher threshold MAXSIZE as well, we truncate before it.  */
 200       if (NILP (elt))
 201         {
 202           if (size_so_far > maxsize)
 203             break;
 204           last_boundary = prev;
 205           if (size_so_far > minsize)
 206             break;
 207         }
 208
 209       /* Add in the space occupied by this element and its chain link.  */
 210       size_so_far += sizeof (struct Lisp_Cons);
 211       if (XTYPE (elt) == Lisp_Cons)
 212         {
 213           size_so_far += sizeof (struct Lisp_Cons);
 214           if (XTYPE (XCONS (elt)->car) == Lisp_String)
 215             size_so_far += (sizeof (struct Lisp_String) - 1
 216                             + XSTRING (XCONS (elt)->car)->size);
 217         }
 218
 219       /* Advance to next element.  */
 220       prev = next;
 221       next = XCONS (next)->cdr;
 222     }
 223
 224   /* If we scanned the whole list, it is short enough; don't change it.  */
 225   if (NILP (next))
 226     return list;
 227
 228   /* Truncate at the boundary where we decided to truncate.  */
 229   if (!NILP (last_boundary))
 230     {
 231       XCONS (last_boundary)->cdr = Qnil;
 232       return list;
 233     }
 234   else
 235     return Qnil;
 236 }
 237 \f
 238 DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0,
 239   "Undo N records from the front of the list LIST.\n\
 240 Return what remains of the list.")
 241   (count, list)
 242      Lisp_Object count, list;
 243 {
 244   register int arg = XINT (count);
 245 #if 0  /* This is a good feature, but would make undo-start
 246           unable to do what is expected.  */
 247   Lisp_Object tem;
 248
 249   /* If the head of the list is a boundary, it is the boundary
 250      preceding this command.  Get rid of it and don't count it.  */
 251   tem = Fcar (list);
 252   if (NILP (tem))
 253     list = Fcdr (list);
 254 #endif
 255
 256   while (arg > 0)
 257     {
 258       while (1)
 259         {
 260           Lisp_Object next, car, cdr;
 261           next = Fcar (list);
 262           list = Fcdr (list);
 263           if (NILP (next))
 264             break;
 265           car = Fcar (next);
 266           cdr = Fcdr (next);
 267           if (EQ (car, Qt))
 268             {
 269               Lisp_Object high, low;
 270               int mod_time;
 271               high = Fcar (cdr);
 272               low = Fcdr (cdr);
 273               mod_time = (high << 16) + low;
 274               /* If this records an obsolete save
 275                  (not matching the actual disk file)
 276                  then don't mark unmodified.  */
 277               if (mod_time != current_buffer->modtime)
 278                 break;
 279 #ifdef CLASH_DETECTION
 280               Funlock_buffer ();
 281 #endif /* CLASH_DETECTION */
 282               Fset_buffer_modified_p (Qnil);
 283             }
 284           else if (XTYPE (car) == Lisp_Int && XTYPE (cdr) == Lisp_Int)
 285             {
 286               Lisp_Object end;
 287               if (XINT (car) < BEGV
 288                   || XINT (cdr) > ZV)
 289                 error ("Changes to be undone are outside visible portion of buffer");
 290               Fdelete_region (car, cdr);
 291               Fgoto_char (car);
 292             }
 293           else if (XTYPE (car) == Lisp_String && XTYPE (cdr) == Lisp_Int)
 294             {
 295               Lisp_Object membuf;
 296               int pos = XINT (cdr);
 297               membuf = car;
 298               if (pos < 0)
 299                 {
 300                   if (-pos < BEGV || -pos > ZV)
 301                     error ("Changes to be undone are outside visible portion of buffer");
 302                   SET_PT (-pos);
 303                   Finsert (1, &membuf);
 304                 }
 305               else
 306                 {
 307                   if (pos < BEGV || pos > ZV)
 308                     error ("Changes to be undone are outside visible portion of buffer");
 309                   SET_PT (pos);
 310                   Finsert (1, &membuf);
 311                   SET_PT (pos);
 312                 }
 313             }
 314         }
 315       arg--;
 316     }
 317
 318   return list;
 319 }
 320
 321 syms_of_undo ()
 322 {
 323   defsubr (&Sprimitive_undo);
 324   defsubr (&Sundo_boundary);
 325 }