code.delx.au - gnu-emacs/blob - 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 distributed in the hope that it will be useful,
   7 but WITHOUT ANY WARRANTY.  No author or distributor
   8 accepts responsibility to anyone for the consequences of using it
   9 or for whether it serves any particular purpose or works at all,
  10 unless he says so in writing.  Refer to the GNU Emacs General Public
  11 License for full details.
  12
  13 Everyone is granted permission to copy, modify and redistribute
  14 GNU Emacs, but only under the conditions described in the
  15 GNU Emacs General Public License.   A copy of this license is
  16 supposed to have been given to you along with GNU Emacs so you
  17 can know your rights and responsibilities.  It should be in a
  18 file named COPYING.  Among other things, the copyright notice
  19 and this notice must be preserved on all copies.  */
  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 record_insert (beg, length)
  45      Lisp_Object beg, length;
  46 {
  47   Lisp_Object lbeg, lend;
  48
  49   if (EQ (current_buffer->undo_list, Qt))
  50     return;
  51
  52   /* Allocate a cons cell to be the undo boundary after this command.  */
  53   if (NILP (pending_boundary))
  54     pending_boundary = Fcons (Qnil, Qnil);
  55
  56   if (current_buffer != XBUFFER (last_undo_buffer))
  57     Fundo_boundary ();
  58   XSETBUFFER (last_undo_buffer, current_buffer);
  59
  60   if (MODIFF <= current_buffer->save_modified)
  61     record_first_change ();
  62
  63   /* If this is following another insertion and consecutive with it
  64      in the buffer, combine the two.  */
  65   if (CONSP (current_buffer->undo_list))
  66     {
  67       Lisp_Object elt;
  68       elt = XCONS (current_buffer->undo_list)->car;
  69       if (CONSP (elt)
  70           && INTEGERP (XCONS (elt)->car)
  71           && INTEGERP (XCONS (elt)->cdr)
  72           && XINT (XCONS (elt)->cdr) == XINT (beg))
  73         {
  74           XSETINT (XCONS (elt)->cdr, XINT (beg) + XINT (length));
  75           return;
  76         }
  77     }
  78
  79   lbeg = beg;
  80   XSETINT (lend, XINT (beg) + XINT (length));
  81   current_buffer->undo_list = Fcons (Fcons (lbeg, lend),
  82                                      current_buffer->undo_list);
  83 }
  84
  85 /* Record that a deletion is about to take place,
  86    for LENGTH characters at location BEG.  */
  87
  88 record_delete (beg, length)
  89      int beg, length;
  90 {
  91   Lisp_Object lbeg, lend, sbeg;
  92   int at_boundary;
  93
  94   if (EQ (current_buffer->undo_list, Qt))
  95     return;
  96
  97   /* Allocate a cons cell to be the undo boundary after this command.  */
  98   if (NILP (pending_boundary))
  99     pending_boundary = Fcons (Qnil, Qnil);
 100
 101   if (current_buffer != XBUFFER (last_undo_buffer))
 102     Fundo_boundary ();
 103   XSETBUFFER (last_undo_buffer, current_buffer);
 104
 105   at_boundary = (CONSP (current_buffer->undo_list)
 106                  && NILP (XCONS (current_buffer->undo_list)->car));
 107
 108   if (MODIFF <= current_buffer->save_modified)
 109     record_first_change ();
 110
 111   if (point == beg + length)
 112     XSETINT (sbeg, -beg);
 113   else
 114     XFASTINT (sbeg) = beg;
 115   XFASTINT (lbeg) = beg;
 116   XFASTINT (lend) = beg + length;
 117
 118   /* If we are just after an undo boundary, and
 119      point wasn't at start of deleted range, record where it was.  */
 120   if (at_boundary
 121       && last_point_position != XFASTINT (sbeg)
 122       && current_buffer == XBUFFER (last_point_position_buffer))
 123     current_buffer->undo_list
 124       = Fcons (make_number (last_point_position), current_buffer->undo_list);
 125
 126   current_buffer->undo_list
 127     = Fcons (Fcons (Fbuffer_substring (lbeg, lend), sbeg),
 128              current_buffer->undo_list);
 129 }
 130
 131 /* Record that a replacement is about to take place,
 132    for LENGTH characters at location BEG.
 133    The replacement does not change the number of characters.  */
 134
 135 record_change (beg, length)
 136      int beg, length;
 137 {
 138   record_delete (beg, length);
 139   record_insert (beg, length);
 140 }
 141 \f
 142 /* Record that an unmodified buffer is about to be changed.
 143    Record the file modification date so that when undoing this entry
 144    we can tell whether it is obsolete because the file was saved again.  */
 145
 146 record_first_change ()
 147 {
 148   Lisp_Object high, low;
 149
 150   if (EQ (current_buffer->undo_list, Qt))
 151     return;
 152
 153   if (current_buffer != XBUFFER (last_undo_buffer))
 154     Fundo_boundary ();
 155   XSETBUFFER (last_undo_buffer, current_buffer);
 156
 157   XFASTINT (high) = (current_buffer->modtime >> 16) & 0xffff;
 158   XFASTINT (low) = current_buffer->modtime & 0xffff;
 159   current_buffer->undo_list = Fcons (Fcons (Qt, Fcons (high, low)), current_buffer->undo_list);
 160 }
 161
 162 /* Record a change in property PROP (whose old value was VAL)
 163    for LENGTH characters starting at position BEG in BUFFER.  */
 164
 165 record_property_change (beg, length, prop, value, buffer)
 166      int beg, length;
 167      Lisp_Object prop, value, buffer;
 168 {
 169   Lisp_Object lbeg, lend, entry;
 170   struct buffer *obuf = current_buffer;
 171   int boundary = 0;
 172
 173   if (EQ (XBUFFER (buffer)->undo_list, Qt))
 174     return;
 175
 176   /* Allocate a cons cell to be the undo boundary after this command.  */
 177   if (NILP (pending_boundary))
 178     pending_boundary = Fcons (Qnil, Qnil);
 179
 180   if (!EQ (buffer, last_undo_buffer))
 181     boundary = 1;
 182   last_undo_buffer = buffer;
 183
 184   /* Switch temporarily to the buffer that was changed.  */
 185   current_buffer = XBUFFER (buffer);
 186
 187   if (boundary)
 188     Fundo_boundary ();
 189
 190   if (MODIFF <= current_buffer->save_modified)
 191     record_first_change ();
 192
 193   XSETINT (lbeg, beg);
 194   XSETINT (lend, beg + length);
 195   entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend))));
 196   current_buffer->undo_list = Fcons (entry, current_buffer->undo_list);
 197
 198   current_buffer = obuf;
 199 }
 200
 201 DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0,
 202   "Mark a boundary between units of undo.\n\
 203 An undo command will stop at this point,\n\
 204 but another undo command will undo to the previous boundary.")
 205   ()
 206 {
 207   Lisp_Object tem;
 208   if (EQ (current_buffer->undo_list, Qt))
 209     return Qnil;
 210   tem = Fcar (current_buffer->undo_list);
 211   if (!NILP (tem))
 212     {
 213       /* One way or another, cons nil onto the front of the undo list.  */
 214       if (!NILP (pending_boundary))
 215         {
 216           /* If we have preallocated the cons cell to use here,
 217              use that one.  */
 218           XCONS (pending_boundary)->cdr = current_buffer->undo_list;
 219           current_buffer->undo_list = pending_boundary;
 220           pending_boundary = Qnil;
 221         }
 222       else
 223         current_buffer->undo_list = Fcons (Qnil, current_buffer->undo_list);
 224     }
 225   return Qnil;
 226 }
 227
 228 /* At garbage collection time, make an undo list shorter at the end,
 229    returning the truncated list.
 230    MINSIZE and MAXSIZE are the limits on size allowed, as described below.
 231    In practice, these are the values of undo-limit and
 232    undo-strong-limit.  */
 233
 234 Lisp_Object
 235 truncate_undo_list (list, minsize, maxsize)
 236      Lisp_Object list;
 237      int minsize, maxsize;
 238 {
 239   Lisp_Object prev, next, last_boundary;
 240   int size_so_far = 0;
 241
 242   prev = Qnil;
 243   next = list;
 244   last_boundary = Qnil;
 245
 246   /* Always preserve at least the most recent undo record.
 247      If the first element is an undo boundary, skip past it.
 248
 249      Skip, skip, skip the undo, skip, skip, skip the undo,
 250      Skip, skip, skip the undo, skip to the undo bound'ry.
 251      (Get it?  "Skip to my Loo?")  */
 252   if (CONSP (next) && NILP (XCONS (next)->car))
 253     {
 254       /* Add in the space occupied by this element and its chain link.  */
 255       size_so_far += sizeof (struct Lisp_Cons);
 256
 257       /* Advance to next element.  */
 258       prev = next;
 259       next = XCONS (next)->cdr;
 260     }
 261   while (CONSP (next) && ! NILP (XCONS (next)->car))
 262     {
 263       Lisp_Object elt;
 264       elt = XCONS (next)->car;
 265
 266       /* Add in the space occupied by this element and its chain link.  */
 267       size_so_far += sizeof (struct Lisp_Cons);
 268       if (CONSP (elt))
 269         {
 270           size_so_far += sizeof (struct Lisp_Cons);
 271           if (STRINGP (XCONS (elt)->car))
 272             size_so_far += (sizeof (struct Lisp_String) - 1
 273                             + XSTRING (XCONS (elt)->car)->size);
 274         }
 275
 276       /* Advance to next element.  */
 277       prev = next;
 278       next = XCONS (next)->cdr;
 279     }
 280   if (CONSP (next))
 281     last_boundary = prev;
 282
 283   while (CONSP (next))
 284     {
 285       Lisp_Object elt;
 286       elt = XCONS (next)->car;
 287
 288       /* When we get to a boundary, decide whether to truncate
 289          either before or after it.  The lower threshold, MINSIZE,
 290          tells us to truncate after it.  If its size pushes past
 291          the higher threshold MAXSIZE as well, we truncate before it.  */
 292       if (NILP (elt))
 293         {
 294           if (size_so_far > maxsize)
 295             break;
 296           last_boundary = prev;
 297           if (size_so_far > minsize)
 298             break;
 299         }
 300
 301       /* Add in the space occupied by this element and its chain link.  */
 302       size_so_far += sizeof (struct Lisp_Cons);
 303       if (CONSP (elt))
 304         {
 305           size_so_far += sizeof (struct Lisp_Cons);
 306           if (STRINGP (XCONS (elt)->car))
 307             size_so_far += (sizeof (struct Lisp_String) - 1
 308                             + XSTRING (XCONS (elt)->car)->size);
 309         }
 310
 311       /* Advance to next element.  */
 312       prev = next;
 313       next = XCONS (next)->cdr;
 314     }
 315
 316   /* If we scanned the whole list, it is short enough; don't change it.  */
 317   if (NILP (next))
 318     return list;
 319
 320   /* Truncate at the boundary where we decided to truncate.  */
 321   if (!NILP (last_boundary))
 322     {
 323       XCONS (last_boundary)->cdr = Qnil;
 324       return list;
 325     }
 326   else
 327     return Qnil;
 328 }
 329 \f
 330 DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0,
 331   "Undo N records from the front of the list LIST.\n\
 332 Return what remains of the list.")
 333   (n, list)
 334      Lisp_Object n, list;
 335 {
 336   struct gcpro gcpro1, gcpro2;
 337   Lisp_Object next;
 338   int count = specpdl_ptr - specpdl;
 339   register int arg;
 340 #if 0  /* This is a good feature, but would make undo-start
 341           unable to do what is expected.  */
 342   Lisp_Object tem;
 343
 344   /* If the head of the list is a boundary, it is the boundary
 345      preceding this command.  Get rid of it and don't count it.  */
 346   tem = Fcar (list);
 347   if (NILP (tem))
 348     list = Fcdr (list);
 349 #endif
 350
 351   CHECK_NUMBER (n, 0);
 352   arg = XINT (n);
 353   next = Qnil;
 354   GCPRO2 (next, list);
 355
 356   /* Don't let read-only properties interfere with undo.  */
 357   if (NILP (current_buffer->read_only))
 358     specbind (Qinhibit_read_only, Qt);
 359
 360   while (arg > 0)
 361     {
 362       while (1)
 363         {
 364           next = Fcar (list);
 365           list = Fcdr (list);
 366           /* Exit inner loop at undo boundary.  */
 367           if (NILP (next))
 368             break;
 369           /* Handle an integer by setting point to that value.  */
 370           if (INTEGERP (next))
 371             SET_PT (clip_to_bounds (BEGV, XINT (next), ZV));
 372           else if (CONSP (next))
 373             {
 374               Lisp_Object car, cdr;
 375
 376               car = Fcar (next);
 377               cdr = Fcdr (next);
 378               if (EQ (car, Qt))
 379                 {
 380                   /* Element (t high . low) records previous modtime.  */
 381                   Lisp_Object high, low;
 382                   int mod_time;
 383
 384                   high = Fcar (cdr);
 385                   low = Fcdr (cdr);
 386                   mod_time = (XFASTINT (high) << 16) + XFASTINT (low);
 387                   /* If this records an obsolete save
 388                      (not matching the actual disk file)
 389                      then don't mark unmodified.  */
 390                   if (mod_time != current_buffer->modtime)
 391                     break;
 392 #ifdef CLASH_DETECTION
 393                   Funlock_buffer ();
 394 #endif /* CLASH_DETECTION */
 395                   Fset_buffer_modified_p (Qnil);
 396                 }
 397 #ifdef USE_TEXT_PROPERTIES
 398               else if (EQ (car, Qnil))
 399                 {
 400                   /* Element (nil prop val beg . end) is property change.  */
 401                   Lisp_Object beg, end, prop, val;
 402
 403                   prop = Fcar (cdr);
 404                   cdr = Fcdr (cdr);
 405                   val = Fcar (cdr);
 406                   cdr = Fcdr (cdr);
 407                   beg = Fcar (cdr);
 408                   end = Fcdr (cdr);
 409
 410                   Fput_text_property (beg, end, prop, val, Qnil);
 411                 }
 412 #endif /* USE_TEXT_PROPERTIES */
 413               else if (INTEGERP (car) && INTEGERP (cdr))
 414                 {
 415                   /* Element (BEG . END) means range was inserted.  */
 416                   Lisp_Object end;
 417
 418                   if (XINT (car) < BEGV
 419                       || XINT (cdr) > ZV)
 420                     error ("Changes to be undone are outside visible portion of buffer");
 421                   /* Set point first thing, so that undoing this undo
 422                      does not send point back to where it is now.  */
 423                   Fgoto_char (car);
 424                   Fdelete_region (car, cdr);
 425                 }
 426               else if (STRINGP (car) && INTEGERP (cdr))
 427                 {
 428                   /* Element (STRING . POS) means STRING was deleted.  */
 429                   Lisp_Object membuf;
 430                   int pos = XINT (cdr);
 431
 432                   membuf = car;
 433                   if (pos < 0)
 434                     {
 435                       if (-pos < BEGV || -pos > ZV)
 436                         error ("Changes to be undone are outside visible portion of buffer");
 437                       SET_PT (-pos);
 438                       Finsert (1, &membuf);
 439                     }
 440                   else
 441                     {
 442                       if (pos < BEGV || pos > ZV)
 443                         error ("Changes to be undone are outside visible portion of buffer");
 444                       SET_PT (pos);
 445
 446                       /* Insert before markers so that if the mark is
 447                          currently on the boundary of this deletion, it
 448                          ends up on the other side of the now-undeleted
 449                          text from point.  Since undo doesn't even keep
 450                          track of the mark, this isn't really necessary,
 451                          but it may lead to better behavior in certain
 452                          situations.  */
 453                       Finsert_before_markers (1, &membuf);
 454                       SET_PT (pos);
 455                     }
 456                 }
 457             }
 458         }
 459       arg--;
 460     }
 461
 462   UNGCPRO;
 463   return unbind_to (count, list);
 464 }
 465
 466 syms_of_undo ()
 467 {
 468   Qinhibit_read_only = intern ("inhibit-read-only");
 469   staticpro (&Qinhibit_read_only);
 470
 471   pending_boundary = Qnil;
 472   staticpro (&pending_boundary);
 473
 474   defsubr (&Sprimitive_undo);
 475   defsubr (&Sundo_boundary);
 476 }