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