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