src/undo.c

   1 /* undo handling for GNU Emacs.
   2    Copyright (C) 1990, 1993, 1994 Free Software Foundation, Inc.
   3
   4 This file is part of GNU Emacs.
   5
   6 GNU Emacs is free software; you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation; either version 2, or (at your option)
   9 any later version.
  10
  11 GNU Emacs is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GNU Emacs; see the file COPYING.  If not, write to
  18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  19 Boston, MA 02111-1307, USA.  */
  20
  21
  22 #include <config.h>
  23 #include "lisp.h"
  24 #include "buffer.h"
  25 #include "commands.h"
  26
  27 /* Last buffer for which undo information was recorded.  */
  28 Lisp_Object last_undo_buffer;
  29
  30 Lisp_Object Qinhibit_read_only;
  31
  32 /* The first time a command records something for undo.
  33    it also allocates the undo-boundary object
  34    which will be added to the list at the end of the command.
  35    This ensures we can't run out of space while trying to make
  36    an undo-boundary.  */
  37 Lisp_Object pending_boundary;
  38
  39 /* Record an insertion that just happened or is about to happen,
  40    for LENGTH characters at position BEG.
  41    (It is possible to record an insertion before or after the fact
  42    because we don't need to record the contents.)  */
  43
  44 record_insert (beg, length)
  45      int beg, length;
  46 {
  47   Lisp_Object lbeg, lend;
  48
  49   if (EQ (current_buffer->undo_list, Qt))
  50     return;
  51
  52   /* Allocate a cons cell to be the undo boundary after this command.  */
  53   if (NILP (pending_boundary))
  54     pending_boundary = Fcons (Qnil, Qnil);
  55
  56   if (current_buffer != XBUFFER (last_undo_buffer))
  57     Fundo_boundary ();
  58   XSETBUFFER (last_undo_buffer, current_buffer);
  59
  60   if (MODIFF <= SAVE_MODIFF)
  61     record_first_change ();
  62
  63   /* If this is following another insertion and consecutive with it
  64      in the buffer, combine the two.  */
  65   if (CONSP (current_buffer->undo_list))
  66     {
  67       Lisp_Object elt;
  68       elt = XCONS (current_buffer->undo_list)->car;
  69       if (CONSP (elt)
  70           && INTEGERP (XCONS (elt)->car)
  71           && INTEGERP (XCONS (elt)->cdr)
  72           && XINT (XCONS (elt)->cdr) == beg)
  73         {
  74           XSETINT (XCONS (elt)->cdr, beg + length);
  75           return;
  76         }
  77     }
  78
  79   XSETFASTINT (lbeg, beg);
  80   XSETINT (lend, beg + length);
  81   current_buffer->undo_list = Fcons (Fcons (lbeg, lend),
  82                                      current_buffer->undo_list);
  83 }
  84
  85 /* Record that a deletion is about to take place,
  86    for LENGTH characters at location BEG.  */
  87
  88 record_delete (beg, length)
  89      int beg, length;
  90 {
  91   Lisp_Object lbeg, lend, sbeg;
  92   int at_boundary;
  93
  94   if (EQ (current_buffer->undo_list, Qt))
  95     return;
  96
  97   /* Allocate a cons cell to be the undo boundary after this command.  */
  98   if (NILP (pending_boundary))
  99     pending_boundary = Fcons (Qnil, Qnil);
 100
 101   if (current_buffer != XBUFFER (last_undo_buffer))
 102     Fundo_boundary ();
 103   XSETBUFFER (last_undo_buffer, current_buffer);
 104
 105   at_boundary = (CONSP (current_buffer->undo_list)
 106                  && NILP (XCONS (current_buffer->undo_list)->car));
 107
 108   if (MODIFF <= SAVE_MODIFF)
 109     record_first_change ();
 110
 111   if (PT == beg + length)
 112     XSETINT (sbeg, -beg);
 113   else
 114     XSETFASTINT (sbeg, beg);
 115   XSETFASTINT (lbeg, beg);
 116   XSETFASTINT (lend, beg + length);
 117
 118   /* If we are just after an undo boundary, and
 119      point wasn't at start of deleted range, record where it was.  */
 120   if (at_boundary
 121       && last_point_position != XFASTINT (sbeg)
 122       && current_buffer == XBUFFER (last_point_position_buffer))
 123     current_buffer->undo_list
 124       = Fcons (make_number (last_point_position), current_buffer->undo_list);
 125
 126   current_buffer->undo_list
 127     = Fcons (Fcons (Fbuffer_substring (lbeg, lend), sbeg),
 128              current_buffer->undo_list);
 129 }
 130
 131 /* Record the fact that MARKER is about to be adjusted by ADJUSTMENT.
 132    This is done only when a marker points within text being deleted,
 133    because that's the only case where an automatic marker adjustment
 134    won't be inverted automatically by undoing the buffer modification.  */
 135
 136 record_marker_adjustment (marker, adjustment)
 137      Lisp_Object marker;
 138      int adjustment;
 139 {
 140   if (EQ (current_buffer->undo_list, Qt))
 141     return;
 142
 143   /* Allocate a cons cell to be the undo boundary after this command.  */
 144   if (NILP (pending_boundary))
 145     pending_boundary = Fcons (Qnil, Qnil);
 146
 147   if (current_buffer != XBUFFER (last_undo_buffer))
 148     Fundo_boundary ();
 149   XSETBUFFER (last_undo_buffer, current_buffer);
 150
 151   current_buffer->undo_list
 152     = Fcons (Fcons (marker, make_number (adjustment)),
 153              current_buffer->undo_list);
 154 }
 155
 156 /* Record that a replacement is about to take place,
 157    for LENGTH characters at location BEG.
 158    The replacement does not change the number of characters.  */
 159
 160 record_change (beg, length)
 161      int beg, length;
 162 {
 163   record_delete (beg, length);
 164   record_insert (beg, length);
 165 }
 166 \f
 167 /* Record that an unmodified buffer is about to be changed.
 168    Record the file modification date so that when undoing this entry
 169    we can tell whether it is obsolete because the file was saved again.  */
 170
 171 record_first_change ()
 172 {
 173   Lisp_Object high, low;
 174   struct buffer *base_buffer = current_buffer;
 175
 176   if (EQ (current_buffer->undo_list, Qt))
 177     return;
 178
 179   if (current_buffer != XBUFFER (last_undo_buffer))
 180     Fundo_boundary ();
 181   XSETBUFFER (last_undo_buffer, current_buffer);
 182
 183   if (base_buffer->base_buffer)
 184     base_buffer = base_buffer->base_buffer;
 185
 186   XSETFASTINT (high, (base_buffer->modtime >> 16) & 0xffff);
 187   XSETFASTINT (low, base_buffer->modtime & 0xffff);
 188   current_buffer->undo_list = Fcons (Fcons (Qt, Fcons (high, low)), current_buffer->undo_list);
 189 }
 190
 191 /* Record a change in property PROP (whose old value was VAL)
 192    for LENGTH characters starting at position BEG in BUFFER.  */
 193
 194 record_property_change (beg, length, prop, value, buffer)
 195      int beg, length;
 196      Lisp_Object prop, value, buffer;
 197 {
 198   Lisp_Object lbeg, lend, entry;
 199   struct buffer *obuf = current_buffer;
 200   int boundary = 0;
 201
 202   if (EQ (XBUFFER (buffer)->undo_list, Qt))
 203     return;
 204
 205   /* Allocate a cons cell to be the undo boundary after this command.  */
 206   if (NILP (pending_boundary))
 207     pending_boundary = Fcons (Qnil, Qnil);
 208
 209   if (!EQ (buffer, last_undo_buffer))
 210     boundary = 1;
 211   last_undo_buffer = buffer;
 212
 213   /* Switch temporarily to the buffer that was changed.  */
 214   current_buffer = XBUFFER (buffer);
 215
 216   if (boundary)
 217     Fundo_boundary ();
 218
 219   if (MODIFF <= SAVE_MODIFF)
 220     record_first_change ();
 221
 222   XSETINT (lbeg, beg);
 223   XSETINT (lend, beg + length);
 224   entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend))));
 225   current_buffer->undo_list = Fcons (entry, current_buffer->undo_list);
 226
 227   current_buffer = obuf;
 228 }
 229
 230 DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0,
 231   "Mark a boundary between units of undo.\n\
 232 An undo command will stop at this point,\n\
 233 but another undo command will undo to the previous boundary.")
 234   ()
 235 {
 236   Lisp_Object tem;
 237   if (EQ (current_buffer->undo_list, Qt))
 238     return Qnil;
 239   tem = Fcar (current_buffer->undo_list);
 240   if (!NILP (tem))
 241     {
 242       /* One way or another, cons nil onto the front of the undo list.  */
 243       if (!NILP (pending_boundary))
 244         {
 245           /* If we have preallocated the cons cell to use here,
 246              use that one.  */
 247           XCONS (pending_boundary)->cdr = current_buffer->undo_list;
 248           current_buffer->undo_list = pending_boundary;
 249           pending_boundary = Qnil;
 250         }
 251       else
 252         current_buffer->undo_list = Fcons (Qnil, current_buffer->undo_list);
 253     }
 254   return Qnil;
 255 }
 256
 257 /* At garbage collection time, make an undo list shorter at the end,
 258    returning the truncated list.
 259    MINSIZE and MAXSIZE are the limits on size allowed, as described below.
 260    In practice, these are the values of undo-limit and
 261    undo-strong-limit.  */
 262
 263 Lisp_Object
 264 truncate_undo_list (list, minsize, maxsize)
 265      Lisp_Object list;
 266      int minsize, maxsize;
 267 {
 268   Lisp_Object prev, next, last_boundary;
 269   int size_so_far = 0;
 270
 271   prev = Qnil;
 272   next = list;
 273   last_boundary = Qnil;
 274
 275   /* Always preserve at least the most recent undo record.
 276      If the first element is an undo boundary, skip past it.
 277
 278      Skip, skip, skip the undo, skip, skip, skip the undo,
 279      Skip, skip, skip the undo, skip to the undo bound'ry.
 280      (Get it?  "Skip to my Loo?")  */
 281   if (CONSP (next) && NILP (XCONS (next)->car))
 282     {
 283       /* Add in the space occupied by this element and its chain link.  */
 284       size_so_far += sizeof (struct Lisp_Cons);
 285
 286       /* Advance to next element.  */
 287       prev = next;
 288       next = XCONS (next)->cdr;
 289     }
 290   while (CONSP (next) && ! NILP (XCONS (next)->car))
 291     {
 292       Lisp_Object elt;
 293       elt = XCONS (next)->car;
 294
 295       /* Add in the space occupied by this element and its chain link.  */
 296       size_so_far += sizeof (struct Lisp_Cons);
 297       if (CONSP (elt))
 298         {
 299           size_so_far += sizeof (struct Lisp_Cons);
 300           if (STRINGP (XCONS (elt)->car))
 301             size_so_far += (sizeof (struct Lisp_String) - 1
 302                             + XSTRING (XCONS (elt)->car)->size);
 303         }
 304
 305       /* Advance to next element.  */
 306       prev = next;
 307       next = XCONS (next)->cdr;
 308     }
 309   if (CONSP (next))
 310     last_boundary = prev;
 311
 312   while (CONSP (next))
 313     {
 314       Lisp_Object elt;
 315       elt = XCONS (next)->car;
 316
 317       /* When we get to a boundary, decide whether to truncate
 318          either before or after it.  The lower threshold, MINSIZE,
 319          tells us to truncate after it.  If its size pushes past
 320          the higher threshold MAXSIZE as well, we truncate before it.  */
 321       if (NILP (elt))
 322         {
 323           if (size_so_far > maxsize)
 324             break;
 325           last_boundary = prev;
 326           if (size_so_far > minsize)
 327             break;
 328         }
 329
 330       /* Add in the space occupied by this element and its chain link.  */
 331       size_so_far += sizeof (struct Lisp_Cons);
 332       if (CONSP (elt))
 333         {
 334           size_so_far += sizeof (struct Lisp_Cons);
 335           if (STRINGP (XCONS (elt)->car))
 336             size_so_far += (sizeof (struct Lisp_String) - 1
 337                             + XSTRING (XCONS (elt)->car)->size);
 338         }
 339
 340       /* Advance to next element.  */
 341       prev = next;
 342       next = XCONS (next)->cdr;
 343     }
 344
 345   /* If we scanned the whole list, it is short enough; don't change it.  */
 346   if (NILP (next))
 347     return list;
 348
 349   /* Truncate at the boundary where we decided to truncate.  */
 350   if (!NILP (last_boundary))
 351     {
 352       XCONS (last_boundary)->cdr = Qnil;
 353       return list;
 354     }
 355   else
 356     return Qnil;
 357 }
 358 \f
 359 DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0,
 360   "Undo N records from the front of the list LIST.\n\
 361 Return what remains of the list.")
 362   (n, list)
 363      Lisp_Object n, list;
 364 {
 365   struct gcpro gcpro1, gcpro2;
 366   Lisp_Object next;
 367   int count = specpdl_ptr - specpdl;
 368   register int arg;
 369 #if 0  /* This is a good feature, but would make undo-start
 370           unable to do what is expected.  */
 371   Lisp_Object tem;
 372
 373   /* If the head of the list is a boundary, it is the boundary
 374      preceding this command.  Get rid of it and don't count it.  */
 375   tem = Fcar (list);
 376   if (NILP (tem))
 377     list = Fcdr (list);
 378 #endif
 379
 380   CHECK_NUMBER (n, 0);
 381   arg = XINT (n);
 382   next = Qnil;
 383   GCPRO2 (next, list);
 384
 385   /* Don't let read-only properties interfere with undo.  */
 386   if (NILP (current_buffer->read_only))
 387     specbind (Qinhibit_read_only, Qt);
 388
 389   while (arg > 0)
 390     {
 391       while (1)
 392         {
 393           next = Fcar (list);
 394           list = Fcdr (list);
 395           /* Exit inner loop at undo boundary.  */
 396           if (NILP (next))
 397             break;
 398           /* Handle an integer by setting point to that value.  */
 399           if (INTEGERP (next))
 400             SET_PT (clip_to_bounds (BEGV, XINT (next), ZV));
 401           else if (CONSP (next))
 402             {
 403               Lisp_Object car, cdr;
 404
 405               car = Fcar (next);
 406               cdr = Fcdr (next);
 407               if (EQ (car, Qt))
 408                 {
 409                   /* Element (t high . low) records previous modtime.  */
 410                   Lisp_Object high, low;
 411                   int mod_time;
 412                   struct buffer *base_buffer = current_buffer;
 413
 414                   high = Fcar (cdr);
 415                   low = Fcdr (cdr);
 416                   mod_time = (XFASTINT (high) << 16) + XFASTINT (low);
 417
 418                   if (current_buffer->base_buffer)
 419                     base_buffer = current_buffer->base_buffer;
 420
 421                   /* If this records an obsolete save
 422                      (not matching the actual disk file)
 423                      then don't mark unmodified.  */
 424                   if (mod_time != base_buffer->modtime)
 425                     continue;
 426 #ifdef CLASH_DETECTION
 427                   Funlock_buffer ();
 428 #endif /* CLASH_DETECTION */
 429                   Fset_buffer_modified_p (Qnil);
 430                 }
 431 #ifdef USE_TEXT_PROPERTIES
 432               else if (EQ (car, Qnil))
 433                 {
 434                   /* Element (nil prop val beg . end) is property change.  */
 435                   Lisp_Object beg, end, prop, val;
 436
 437                   prop = Fcar (cdr);
 438                   cdr = Fcdr (cdr);
 439                   val = Fcar (cdr);
 440                   cdr = Fcdr (cdr);
 441                   beg = Fcar (cdr);
 442                   end = Fcdr (cdr);
 443
 444                   Fput_text_property (beg, end, prop, val, Qnil);
 445                 }
 446 #endif /* USE_TEXT_PROPERTIES */
 447               else if (INTEGERP (car) && INTEGERP (cdr))
 448                 {
 449                   /* Element (BEG . END) means range was inserted.  */
 450                   Lisp_Object end;
 451
 452                   if (XINT (car) < BEGV
 453                       || XINT (cdr) > ZV)
 454                     error ("Changes to be undone are outside visible portion of buffer");
 455                   /* Set point first thing, so that undoing this undo
 456                      does not send point back to where it is now.  */
 457                   Fgoto_char (car);
 458                   Fdelete_region (car, cdr);
 459                 }
 460               else if (STRINGP (car) && INTEGERP (cdr))
 461                 {
 462                   /* Element (STRING . POS) means STRING was deleted.  */
 463                   Lisp_Object membuf;
 464                   int pos = XINT (cdr);
 465
 466                   membuf = car;
 467                   if (pos < 0)
 468                     {
 469                       if (-pos < BEGV || -pos > ZV)
 470                         error ("Changes to be undone are outside visible portion of buffer");
 471                       SET_PT (-pos);
 472                       Finsert (1, &membuf);
 473                     }
 474                   else
 475                     {
 476                       if (pos < BEGV || pos > ZV)
 477                         error ("Changes to be undone are outside visible portion of buffer");
 478                       SET_PT (pos);
 479
 480                       /* Now that we record marker adjustments
 481                          (caused by deletion) for undo,
 482                          we should always insert after markers,
 483                          so that undoing the marker adjustments
 484                          put the markers back in the right place.  */
 485                       Finsert (1, &membuf);
 486                       SET_PT (pos);
 487                     }
 488                 }
 489               else if (MARKERP (car) && INTEGERP (cdr))
 490                 {
 491                   /* (MARKER . INTEGER) means a marker MARKER
 492                      was adjusted by INTEGER.  */
 493                   if (XMARKER (car)->buffer)
 494                     Fset_marker (car,
 495                                  make_number (marker_position (car) - XINT (cdr)),
 496                                  Fmarker_buffer (car));
 497                 }
 498             }
 499         }
 500       arg--;
 501     }
 502
 503   UNGCPRO;
 504   return unbind_to (count, list);
 505 }
 506
 507 syms_of_undo ()
 508 {
 509   Qinhibit_read_only = intern ("inhibit-read-only");
 510   staticpro (&Qinhibit_read_only);
 511
 512   pending_boundary = Qnil;
 513   staticpro (&pending_boundary);
 514
 515   defsubr (&Sprimitive_undo);
 516   defsubr (&Sundo_boundary);
 517 }