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