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