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 and MAXSIZE are the limits on size allowed, as described below.
 296    In practice, these are the values of undo-limit and
 297    undo-strong-limit.  */
 298
 299 Lisp_Object
 300 truncate_undo_list (list, minsize, maxsize)
 301      Lisp_Object list;
 302      int minsize, maxsize;
 303 {
 304   Lisp_Object prev, next, last_boundary;
 305   int size_so_far = 0;
 306
 307   prev = Qnil;
 308   next = list;
 309   last_boundary = Qnil;
 310
 311   /* Always preserve at least the most recent undo record.
 312      If the first element is an undo boundary, skip past it.
 313
 314      Skip, skip, skip the undo, skip, skip, skip the undo,
 315      Skip, skip, skip the undo, skip to the undo bound'ry.
 316      (Get it?  "Skip to my Loo?")  */
 317   if (CONSP (next) && NILP (XCAR (next)))
 318     {
 319       /* Add in the space occupied by this element and its chain link.  */
 320       size_so_far += sizeof (struct Lisp_Cons);
 321
 322       /* Advance to next element.  */
 323       prev = next;
 324       next = XCDR (next);
 325     }
 326   while (CONSP (next) && ! NILP (XCAR (next)))
 327     {
 328       Lisp_Object elt;
 329       elt = XCAR (next);
 330
 331       /* Add in the space occupied by this element and its chain link.  */
 332       size_so_far += sizeof (struct Lisp_Cons);
 333       if (CONSP (elt))
 334         {
 335           size_so_far += sizeof (struct Lisp_Cons);
 336           if (STRINGP (XCAR (elt)))
 337             size_so_far += (sizeof (struct Lisp_String) - 1
 338                             + SCHARS (XCAR (elt)));
 339         }
 340
 341       /* Advance to next element.  */
 342       prev = next;
 343       next = XCDR (next);
 344     }
 345   if (CONSP (next))
 346     last_boundary = prev;
 347
 348   while (CONSP (next))
 349     {
 350       Lisp_Object elt;
 351       elt = XCAR (next);
 352
 353       /* When we get to a boundary, decide whether to truncate
 354          either before or after it.  The lower threshold, MINSIZE,
 355          tells us to truncate after it.  If its size pushes past
 356          the higher threshold MAXSIZE as well, we truncate before it.  */
 357       if (NILP (elt))
 358         {
 359           if (size_so_far > maxsize)
 360             break;
 361           last_boundary = prev;
 362           if (size_so_far > minsize)
 363             break;
 364         }
 365
 366       /* Add in the space occupied by this element and its chain link.  */
 367       size_so_far += sizeof (struct Lisp_Cons);
 368       if (CONSP (elt))
 369         {
 370           size_so_far += sizeof (struct Lisp_Cons);
 371           if (STRINGP (XCAR (elt)))
 372             size_so_far += (sizeof (struct Lisp_String) - 1
 373                             + SCHARS (XCAR (elt)));
 374         }
 375
 376       /* Advance to next element.  */
 377       prev = next;
 378       next = XCDR (next);
 379     }
 380
 381   /* If we scanned the whole list, it is short enough; don't change it.  */
 382   if (NILP (next))
 383     return list;
 384
 385   /* Truncate at the boundary where we decided to truncate.  */
 386   if (!NILP (last_boundary))
 387     {
 388       XSETCDR (last_boundary, Qnil);
 389       return list;
 390     }
 391   else
 392     return Qnil;
 393 }
 394 \f
 395 DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0,
 396        doc: /* Undo N records from the front of the list LIST.
 397 Return what remains of the list.  */)
 398      (n, list)
 399      Lisp_Object n, list;
 400 {
 401   struct gcpro gcpro1, gcpro2;
 402   Lisp_Object next;
 403   int count = SPECPDL_INDEX ();
 404   register int arg;
 405
 406 #if 0  /* This is a good feature, but would make undo-start
 407           unable to do what is expected.  */
 408   Lisp_Object tem;
 409
 410   /* If the head of the list is a boundary, it is the boundary
 411      preceding this command.  Get rid of it and don't count it.  */
 412   tem = Fcar (list);
 413   if (NILP (tem))
 414     list = Fcdr (list);
 415 #endif
 416
 417   CHECK_NUMBER (n);
 418   arg = XINT (n);
 419   next = Qnil;
 420   GCPRO2 (next, list);
 421
 422   /* In a writable buffer, enable undoing read-only text that is so
 423      because of text properties.  */
 424   if (NILP (current_buffer->read_only))
 425     specbind (Qinhibit_read_only, Qt);
 426
 427   /* Don't let `intangible' properties interfere with undo.  */
 428   specbind (Qinhibit_point_motion_hooks, Qt);
 429
 430   while (arg > 0)
 431     {
 432       while (CONSP (list))
 433         {
 434           next = XCAR (list);
 435           list = XCDR (list);
 436           /* Exit inner loop at undo boundary.  */
 437           if (NILP (next))
 438             break;
 439           /* Handle an integer by setting point to that value.  */
 440           if (INTEGERP (next))
 441             SET_PT (clip_to_bounds (BEGV, XINT (next), ZV));
 442           else if (CONSP (next))
 443             {
 444               Lisp_Object car, cdr;
 445
 446               car = XCAR (next);
 447               cdr = XCDR (next);
 448               if (EQ (car, Qt))
 449                 {
 450                   /* Element (t high . low) records previous modtime.  */
 451                   Lisp_Object high, low;
 452                   int mod_time;
 453                   struct buffer *base_buffer = current_buffer;
 454
 455                   high = Fcar (cdr);
 456                   low = Fcdr (cdr);
 457                   mod_time = (XFASTINT (high) << 16) + XFASTINT (low);
 458
 459                   if (current_buffer->base_buffer)
 460                     base_buffer = current_buffer->base_buffer;
 461
 462                   /* If this records an obsolete save
 463                      (not matching the actual disk file)
 464                      then don't mark unmodified.  */
 465                   if (mod_time != base_buffer->modtime)
 466                     continue;
 467 #ifdef CLASH_DETECTION
 468                   Funlock_buffer ();
 469 #endif /* CLASH_DETECTION */
 470                   Fset_buffer_modified_p (Qnil);
 471                 }
 472               else if (EQ (car, Qnil))
 473                 {
 474                   /* Element (nil prop val beg . end) is property change.  */
 475                   Lisp_Object beg, end, prop, val;
 476
 477                   prop = Fcar (cdr);
 478                   cdr = Fcdr (cdr);
 479                   val = Fcar (cdr);
 480                   cdr = Fcdr (cdr);
 481                   beg = Fcar (cdr);
 482                   end = Fcdr (cdr);
 483
 484                   Fput_text_property (beg, end, prop, val, Qnil);
 485                 }
 486               else if (INTEGERP (car) && INTEGERP (cdr))
 487                 {
 488                   /* Element (BEG . END) means range was inserted.  */
 489
 490                   if (XINT (car) < BEGV
 491                       || XINT (cdr) > ZV)
 492                     error ("Changes to be undone are outside visible portion of buffer");
 493                   /* Set point first thing, so that undoing this undo
 494                      does not send point back to where it is now.  */
 495                   Fgoto_char (car);
 496                   Fdelete_region (car, cdr);
 497                 }
 498               else if (STRINGP (car) && INTEGERP (cdr))
 499                 {
 500                   /* Element (STRING . POS) means STRING was deleted.  */
 501                   Lisp_Object membuf;
 502                   int pos = XINT (cdr);
 503
 504                   membuf = car;
 505                   if (pos < 0)
 506                     {
 507                       if (-pos < BEGV || -pos > ZV)
 508                         error ("Changes to be undone are outside visible portion of buffer");
 509                       SET_PT (-pos);
 510                       Finsert (1, &membuf);
 511                     }
 512                   else
 513                     {
 514                       if (pos < BEGV || pos > ZV)
 515                         error ("Changes to be undone are outside visible portion of buffer");
 516                       SET_PT (pos);
 517
 518                       /* Now that we record marker adjustments
 519                          (caused by deletion) for undo,
 520                          we should always insert after markers,
 521                          so that undoing the marker adjustments
 522                          put the markers back in the right place.  */
 523                       Finsert (1, &membuf);
 524                       SET_PT (pos);
 525                     }
 526                 }
 527               else if (MARKERP (car) && INTEGERP (cdr))
 528                 {
 529                   /* (MARKER . INTEGER) means a marker MARKER
 530                      was adjusted by INTEGER.  */
 531                   if (XMARKER (car)->buffer)
 532                     Fset_marker (car,
 533                                  make_number (marker_position (car) - XINT (cdr)),
 534                                  Fmarker_buffer (car));
 535                 }
 536             }
 537         }
 538       arg--;
 539     }
 540
 541   UNGCPRO;
 542   return unbind_to (count, list);
 543 }
 544
 545 void
 546 syms_of_undo ()
 547 {
 548   Qinhibit_read_only = intern ("inhibit-read-only");
 549   staticpro (&Qinhibit_read_only);
 550
 551   pending_boundary = Qnil;
 552   staticpro (&pending_boundary);
 553
 554   defsubr (&Sprimitive_undo);
 555   defsubr (&Sundo_boundary);
 556 }