src/undo.c

   1 /* undo handling for GNU Emacs.
   2    Copyright (C) 1990, 1993, 1994, 2000 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 point as it was at beginning of this command (if necessary)
  40    And prepare the undo info for recording a change.
  41    PT is the position of point that will naturally occur as a result of the
  42    undo record that will be added just after this command terminates.  */
  43
  44 static void
  45 record_point (pt)
  46      int pt;
  47 {
  48   int at_boundary;
  49
  50   /* Allocate a cons cell to be the undo boundary after this command.  */
  51   if (NILP (pending_boundary))
  52     pending_boundary = Fcons (Qnil, Qnil);
  53
  54   if (!BUFFERP (last_undo_buffer)
  55       || current_buffer != XBUFFER (last_undo_buffer))
  56     Fundo_boundary ();
  57   XSETBUFFER (last_undo_buffer, current_buffer);
  58
  59   if (CONSP (current_buffer->undo_list))
  60     {
  61       /* Set AT_BOUNDARY to 1 only when we have nothing other than
  62          marker adjustment before undo boundary.  */
  63
  64       Lisp_Object tail = current_buffer->undo_list, elt;
  65
  66       while (1)
  67         {
  68           if (NILP (tail))
  69             elt = Qnil;
  70           else
  71             elt = XCAR (tail);
  72           if (NILP (elt) || ! (CONSP (elt) && MARKERP (XCAR (elt))))
  73             break;
  74           tail = XCDR (tail);
  75         }
  76       at_boundary = NILP (elt);
  77     }
  78   else
  79     at_boundary = 1;
  80
  81   if (MODIFF <= SAVE_MODIFF)
  82     record_first_change ();
  83
  84   /* If we are just after an undo boundary, and
  85      point wasn't at start of deleted range, record where it was.  */
  86   if (at_boundary
  87       && last_point_position != pt
  88       /* If we're called from batch mode, this could be nil.  */
  89       && BUFFERP (last_point_position_buffer)
  90       && current_buffer == XBUFFER (last_point_position_buffer))
  91     current_buffer->undo_list
  92       = Fcons (make_number (last_point_position), current_buffer->undo_list);
  93 }
  94
  95 /* Record an insertion that just happened or is about to happen,
  96    for LENGTH characters at position BEG.
  97    (It is possible to record an insertion before or after the fact
  98    because we don't need to record the contents.)  */
  99
 100 void
 101 record_insert (beg, length)
 102      int beg, length;
 103 {
 104   Lisp_Object lbeg, lend;
 105
 106   if (EQ (current_buffer->undo_list, Qt))
 107     return;
 108
 109   record_point (beg);
 110
 111   /* If this is following another insertion and consecutive with it
 112      in the buffer, combine the two.  */
 113   if (CONSP (current_buffer->undo_list))
 114     {
 115       Lisp_Object elt;
 116       elt = XCAR (current_buffer->undo_list);
 117       if (CONSP (elt)
 118           && INTEGERP (XCAR (elt))
 119           && INTEGERP (XCDR (elt))
 120           && XINT (XCDR (elt)) == beg)
 121         {
 122           XSETCDR (elt, make_number (beg + length));
 123           return;
 124         }
 125     }
 126
 127   XSETFASTINT (lbeg, beg);
 128   XSETINT (lend, beg + length);
 129   current_buffer->undo_list = Fcons (Fcons (lbeg, lend),
 130                                      current_buffer->undo_list);
 131 }
 132
 133 /* Record that a deletion is about to take place,
 134    of the characters in STRING, at location BEG.  */
 135
 136 void
 137 record_delete (beg, string)
 138      int beg;
 139      Lisp_Object string;
 140 {
 141   Lisp_Object sbeg;
 142
 143   if (EQ (current_buffer->undo_list, Qt))
 144     return;
 145
 146   if (PT == beg + SCHARS (string))
 147     {
 148       XSETINT (sbeg, -beg);
 149       record_point (PT);
 150     }
 151   else
 152     {
 153       XSETFASTINT (sbeg, beg);
 154       record_point (beg);
 155     }
 156
 157   current_buffer->undo_list
 158     = Fcons (Fcons (string, sbeg), current_buffer->undo_list);
 159 }
 160
 161 /* Record the fact that MARKER is about to be adjusted by ADJUSTMENT.
 162    This is done only when a marker points within text being deleted,
 163    because that's the only case where an automatic marker adjustment
 164    won't be inverted automatically by undoing the buffer modification.  */
 165
 166 void
 167 record_marker_adjustment (marker, adjustment)
 168      Lisp_Object marker;
 169      int adjustment;
 170 {
 171   if (EQ (current_buffer->undo_list, Qt))
 172     return;
 173
 174   /* Allocate a cons cell to be the undo boundary after this command.  */
 175   if (NILP (pending_boundary))
 176     pending_boundary = Fcons (Qnil, Qnil);
 177
 178   if (!BUFFERP (last_undo_buffer)
 179       || current_buffer != XBUFFER (last_undo_buffer))
 180     Fundo_boundary ();
 181   XSETBUFFER (last_undo_buffer, current_buffer);
 182
 183   current_buffer->undo_list
 184     = Fcons (Fcons (marker, make_number (adjustment)),
 185              current_buffer->undo_list);
 186 }
 187
 188 /* Record that a replacement is about to take place,
 189    for LENGTH characters at location BEG.
 190    The replacement must not change the number of characters.  */
 191
 192 void
 193 record_change (beg, length)
 194      int beg, length;
 195 {
 196   record_delete (beg, make_buffer_string (beg, beg + length, 1));
 197   record_insert (beg, length);
 198 }
 199 \f
 200 /* Record that an unmodified buffer is about to be changed.
 201    Record the file modification date so that when undoing this entry
 202    we can tell whether it is obsolete because the file was saved again.  */
 203
 204 void
 205 record_first_change ()
 206 {
 207   Lisp_Object high, low;
 208   struct buffer *base_buffer = current_buffer;
 209
 210   if (EQ (current_buffer->undo_list, Qt))
 211     return;
 212
 213   if (!BUFFERP (last_undo_buffer)
 214       || current_buffer != XBUFFER (last_undo_buffer))
 215     Fundo_boundary ();
 216   XSETBUFFER (last_undo_buffer, current_buffer);
 217
 218   if (base_buffer->base_buffer)
 219     base_buffer = base_buffer->base_buffer;
 220
 221   XSETFASTINT (high, (base_buffer->modtime >> 16) & 0xffff);
 222   XSETFASTINT (low, base_buffer->modtime & 0xffff);
 223   current_buffer->undo_list = Fcons (Fcons (Qt, Fcons (high, low)), current_buffer->undo_list);
 224 }
 225
 226 /* Record a change in property PROP (whose old value was VAL)
 227    for LENGTH characters starting at position BEG in BUFFER.  */
 228
 229 void
 230 record_property_change (beg, length, prop, value, buffer)
 231      int beg, length;
 232      Lisp_Object prop, value, buffer;
 233 {
 234   Lisp_Object lbeg, lend, entry;
 235   struct buffer *obuf = current_buffer;
 236   int boundary = 0;
 237
 238   if (EQ (XBUFFER (buffer)->undo_list, Qt))
 239     return;
 240
 241   /* Allocate a cons cell to be the undo boundary after this command.  */
 242   if (NILP (pending_boundary))
 243     pending_boundary = Fcons (Qnil, Qnil);
 244
 245   if (!EQ (buffer, last_undo_buffer))
 246     boundary = 1;
 247   last_undo_buffer = buffer;
 248
 249   /* Switch temporarily to the buffer that was changed.  */
 250   current_buffer = XBUFFER (buffer);
 251
 252   if (boundary)
 253     Fundo_boundary ();
 254
 255   if (MODIFF <= SAVE_MODIFF)
 256     record_first_change ();
 257
 258   XSETINT (lbeg, beg);
 259   XSETINT (lend, beg + length);
 260   entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend))));
 261   current_buffer->undo_list = Fcons (entry, current_buffer->undo_list);
 262
 263   current_buffer = obuf;
 264 }
 265
 266 DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0,
 267        doc: /* Mark a boundary between units of undo.
 268 An undo command will stop at this point,
 269 but another undo command will undo to the previous boundary.  */)
 270      ()
 271 {
 272   Lisp_Object tem;
 273   if (EQ (current_buffer->undo_list, Qt))
 274     return Qnil;
 275   tem = Fcar (current_buffer->undo_list);
 276   if (!NILP (tem))
 277     {
 278       /* One way or another, cons nil onto the front of the undo list.  */
 279       if (!NILP (pending_boundary))
 280         {
 281           /* If we have preallocated the cons cell to use here,
 282              use that one.  */
 283           XSETCDR (pending_boundary, current_buffer->undo_list);
 284           current_buffer->undo_list = pending_boundary;
 285           pending_boundary = Qnil;
 286         }
 287       else
 288         current_buffer->undo_list = Fcons (Qnil, current_buffer->undo_list);
 289     }
 290   return Qnil;
 291 }
 292
 293 /* At garbage collection time, make an undo list shorter at the end,
 294    returning the truncated list.
 295    MINSIZE, MAXSIZE and LIMITSIZE are the limits on size allowed,
 296    as described below.
 297    In practice, these are the values of undo-limit,
 298    undo-strong-limit, and undo-outer-limit.  */
 299
 300 Lisp_Object
 301 truncate_undo_list (list, minsize, maxsize, limitsize)
 302      Lisp_Object list;
 303      int minsize, maxsize, limitsize;
 304 {
 305   Lisp_Object prev, next, last_boundary;
 306   int size_so_far = 0;
 307
 308   prev = Qnil;
 309   next = list;
 310   last_boundary = Qnil;
 311
 312   /* Always preserve at least the most recent undo record
 313      unless it is really horribly big.
 314      If the first element is an undo boundary, skip past it.
 315
 316      Skip, skip, skip the undo, skip, skip, skip the undo,
 317      Skip, skip, skip the undo, skip to the undo bound'ry.
 318      (Get it?  "Skip to my Loo?")  */
 319   if (CONSP (next) && NILP (XCAR (next)))
 320     {
 321       /* Add in the space occupied by this element and its chain link.  */
 322       size_so_far += sizeof (struct Lisp_Cons);
 323
 324       /* Advance to next element.  */
 325       prev = next;
 326       next = XCDR (next);
 327     }
 328
 329   while (CONSP (next) && ! NILP (XCAR (next)))
 330     {
 331       Lisp_Object elt;
 332       elt = XCAR (next);
 333
 334       /* Add in the space occupied by this element and its chain link.  */
 335       size_so_far += sizeof (struct Lisp_Cons);
 336       if (CONSP (elt))
 337         {
 338           size_so_far += sizeof (struct Lisp_Cons);
 339           if (STRINGP (XCAR (elt)))
 340             size_so_far += (sizeof (struct Lisp_String) - 1
 341                             + SCHARS (XCAR (elt)));
 342         }
 343
 344       /* If we reach LIMITSIZE before the first boundary,
 345          we're heading for memory full, so truncate the list to nothing.  */
 346       if (size_so_far > limitsize)
 347         return Qnil;
 348
 349       /* Advance to next element.  */
 350       prev = next;
 351       next = XCDR (next);
 352     }
 353
 354   if (CONSP (next))
 355     last_boundary = prev;
 356
 357   /* Keep more if it fits.  */
 358   while (CONSP (next))
 359     {
 360       Lisp_Object elt;
 361       elt = XCAR (next);
 362
 363       /* When we get to a boundary, decide whether to truncate
 364          either before or after it.  The lower threshold, MINSIZE,
 365          tells us to truncate after it.  If its size pushes past
 366          the higher threshold MAXSIZE as well, we truncate before it.  */
 367       if (NILP (elt))
 368         {
 369           if (size_so_far > maxsize)
 370             break;
 371           last_boundary = prev;
 372           if (size_so_far > minsize)
 373             break;
 374         }
 375
 376       /* Add in the space occupied by this element and its chain link.  */
 377       size_so_far += sizeof (struct Lisp_Cons);
 378       if (CONSP (elt))
 379         {
 380           size_so_far += sizeof (struct Lisp_Cons);
 381           if (STRINGP (XCAR (elt)))
 382             size_so_far += (sizeof (struct Lisp_String) - 1
 383                             + SCHARS (XCAR (elt)));
 384         }
 385
 386       /* Advance to next element.  */
 387       prev = next;
 388       next = XCDR (next);
 389     }
 390
 391   /* If we scanned the whole list, it is short enough; don't change it.  */
 392   if (NILP (next))
 393     return list;
 394
 395   /* Truncate at the boundary where we decided to truncate.  */
 396   if (!NILP (last_boundary))
 397     {
 398       XSETCDR (last_boundary, Qnil);
 399       return list;
 400     }
 401   else
 402     return Qnil;
 403 }
 404 \f
 405 DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0,
 406        doc: /* Undo N records from the front of the list LIST.
 407 Return what remains of the list.  */)
 408      (n, list)
 409      Lisp_Object n, list;
 410 {
 411   struct gcpro gcpro1, gcpro2;
 412   Lisp_Object next;
 413   int count = SPECPDL_INDEX ();
 414   register int arg;
 415
 416 #if 0  /* This is a good feature, but would make undo-start
 417           unable to do what is expected.  */
 418   Lisp_Object tem;
 419
 420   /* If the head of the list is a boundary, it is the boundary
 421      preceding this command.  Get rid of it and don't count it.  */
 422   tem = Fcar (list);
 423   if (NILP (tem))
 424     list = Fcdr (list);
 425 #endif
 426
 427   CHECK_NUMBER (n);
 428   arg = XINT (n);
 429   next = Qnil;
 430   GCPRO2 (next, list);
 431
 432   /* In a writable buffer, enable undoing read-only text that is so
 433      because of text properties.  */
 434   if (NILP (current_buffer->read_only))
 435     specbind (Qinhibit_read_only, Qt);
 436
 437   /* Don't let `intangible' properties interfere with undo.  */
 438   specbind (Qinhibit_point_motion_hooks, Qt);
 439
 440   while (arg > 0)
 441     {
 442       while (CONSP (list))
 443         {
 444           next = XCAR (list);
 445           list = XCDR (list);
 446           /* Exit inner loop at undo boundary.  */
 447           if (NILP (next))
 448             break;
 449           /* Handle an integer by setting point to that value.  */
 450           if (INTEGERP (next))
 451             SET_PT (clip_to_bounds (BEGV, XINT (next), ZV));
 452           else if (CONSP (next))
 453             {
 454               Lisp_Object car, cdr;
 455
 456               car = XCAR (next);
 457               cdr = XCDR (next);
 458               if (EQ (car, Qt))
 459                 {
 460                   /* Element (t high . low) records previous modtime.  */
 461                   Lisp_Object high, low;
 462                   int mod_time;
 463                   struct buffer *base_buffer = current_buffer;
 464
 465                   high = Fcar (cdr);
 466                   low = Fcdr (cdr);
 467                   mod_time = (XFASTINT (high) << 16) + XFASTINT (low);
 468
 469                   if (current_buffer->base_buffer)
 470                     base_buffer = current_buffer->base_buffer;
 471
 472                   /* If this records an obsolete save
 473                      (not matching the actual disk file)
 474                      then don't mark unmodified.  */
 475                   if (mod_time != base_buffer->modtime)
 476                     continue;
 477 #ifdef CLASH_DETECTION
 478                   Funlock_buffer ();
 479 #endif /* CLASH_DETECTION */
 480                   Fset_buffer_modified_p (Qnil);
 481                 }
 482               else if (EQ (car, Qnil))
 483                 {
 484                   /* Element (nil prop val beg . end) is property change.  */
 485                   Lisp_Object beg, end, prop, val;
 486
 487                   prop = Fcar (cdr);
 488                   cdr = Fcdr (cdr);
 489                   val = Fcar (cdr);
 490                   cdr = Fcdr (cdr);
 491                   beg = Fcar (cdr);
 492                   end = Fcdr (cdr);
 493
 494                   Fput_text_property (beg, end, prop, val, Qnil);
 495                 }
 496               else if (INTEGERP (car) && INTEGERP (cdr))
 497                 {
 498                   /* Element (BEG . END) means range was inserted.  */
 499
 500                   if (XINT (car) < BEGV
 501                       || XINT (cdr) > ZV)
 502                     error ("Changes to be undone are outside visible portion of buffer");
 503                   /* Set point first thing, so that undoing this undo
 504                      does not send point back to where it is now.  */
 505                   Fgoto_char (car);
 506                   Fdelete_region (car, cdr);
 507                 }
 508               else if (STRINGP (car) && INTEGERP (cdr))
 509                 {
 510                   /* Element (STRING . POS) means STRING was deleted.  */
 511                   Lisp_Object membuf;
 512                   int pos = XINT (cdr);
 513
 514                   membuf = car;
 515                   if (pos < 0)
 516                     {
 517                       if (-pos < BEGV || -pos > ZV)
 518                         error ("Changes to be undone are outside visible portion of buffer");
 519                       SET_PT (-pos);
 520                       Finsert (1, &membuf);
 521                     }
 522                   else
 523                     {
 524                       if (pos < BEGV || pos > ZV)
 525                         error ("Changes to be undone are outside visible portion of buffer");
 526                       SET_PT (pos);
 527
 528                       /* Now that we record marker adjustments
 529                          (caused by deletion) for undo,
 530                          we should always insert after markers,
 531                          so that undoing the marker adjustments
 532                          put the markers back in the right place.  */
 533                       Finsert (1, &membuf);
 534                       SET_PT (pos);
 535                     }
 536                 }
 537               else if (MARKERP (car) && INTEGERP (cdr))
 538                 {
 539                   /* (MARKER . INTEGER) means a marker MARKER
 540                      was adjusted by INTEGER.  */
 541                   if (XMARKER (car)->buffer)
 542                     Fset_marker (car,
 543                                  make_number (marker_position (car) - XINT (cdr)),
 544                                  Fmarker_buffer (car));
 545                 }
 546             }
 547         }
 548       arg--;
 549     }
 550
 551   UNGCPRO;
 552   return unbind_to (count, list);
 553 }
 554
 555 void
 556 syms_of_undo ()
 557 {
 558   Qinhibit_read_only = intern ("inhibit-read-only");
 559   staticpro (&Qinhibit_read_only);
 560
 561   pending_boundary = Qnil;
 562   staticpro (&pending_boundary);
 563
 564   defsubr (&Sprimitive_undo);
 565   defsubr (&Sundo_boundary);
 566 }
 567
 568 /* arch-tag: d546ee01-4aed-4ffb-bb8b-eefaae50d38a
 569    (do not change this comment) */