src/undo.c

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