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   XSET (last_undo_buffer, Lisp_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 (XTYPE (current_buffer->undo_list) == Lisp_Cons)
  66     {
  67       Lisp_Object elt;
  68       elt = XCONS (current_buffer->undo_list)->car;
  69       if (XTYPE (elt) == Lisp_Cons
  70           && XTYPE (XCONS (elt)->car) == Lisp_Int
  71           && XTYPE (XCONS (elt)->cdr) == Lisp_Int
  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   XSET (lend, Lisp_Int, 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   XSET (last_undo_buffer, Lisp_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     XSET (sbeg, Lisp_Int, -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   XSET (last_undo_buffer, Lisp_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   XSET (lbeg, Lisp_Int, beg);
 194   XSET (lend, Lisp_Int, 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 (XTYPE (next) == Lisp_Cons
 253       && NILP (XCONS (next)->car))
 254     {
 255       /* Add in the space occupied by this element and its chain link.  */
 256       size_so_far += sizeof (struct Lisp_Cons);
 257
 258       /* Advance to next element.  */
 259       prev = next;
 260       next = XCONS (next)->cdr;
 261     }
 262   while (XTYPE (next) == Lisp_Cons
 263          && ! NILP (XCONS (next)->car))
 264     {
 265       Lisp_Object elt;
 266       elt = XCONS (next)->car;
 267
 268       /* Add in the space occupied by this element and its chain link.  */
 269       size_so_far += sizeof (struct Lisp_Cons);
 270       if (XTYPE (elt) == Lisp_Cons)
 271         {
 272           size_so_far += sizeof (struct Lisp_Cons);
 273           if (XTYPE (XCONS (elt)->car) == Lisp_String)
 274             size_so_far += (sizeof (struct Lisp_String) - 1
 275                             + XSTRING (XCONS (elt)->car)->size);
 276         }
 277
 278       /* Advance to next element.  */
 279       prev = next;
 280       next = XCONS (next)->cdr;
 281     }
 282   if (XTYPE (next) == Lisp_Cons)
 283     last_boundary = prev;
 284
 285   while (XTYPE (next) == Lisp_Cons)
 286     {
 287       Lisp_Object elt;
 288       elt = XCONS (next)->car;
 289
 290       /* When we get to a boundary, decide whether to truncate
 291          either before or after it.  The lower threshold, MINSIZE,
 292          tells us to truncate after it.  If its size pushes past
 293          the higher threshold MAXSIZE as well, we truncate before it.  */
 294       if (NILP (elt))
 295         {
 296           if (size_so_far > maxsize)
 297             break;
 298           last_boundary = prev;
 299           if (size_so_far > minsize)
 300             break;
 301         }
 302
 303       /* Add in the space occupied by this element and its chain link.  */
 304       size_so_far += sizeof (struct Lisp_Cons);
 305       if (XTYPE (elt) == Lisp_Cons)
 306         {
 307           size_so_far += sizeof (struct Lisp_Cons);
 308           if (XTYPE (XCONS (elt)->car) == Lisp_String)
 309             size_so_far += (sizeof (struct Lisp_String) - 1
 310                             + XSTRING (XCONS (elt)->car)->size);
 311         }
 312
 313       /* Advance to next element.  */
 314       prev = next;
 315       next = XCONS (next)->cdr;
 316     }
 317
 318   /* If we scanned the whole list, it is short enough; don't change it.  */
 319   if (NILP (next))
 320     return list;
 321
 322   /* Truncate at the boundary where we decided to truncate.  */
 323   if (!NILP (last_boundary))
 324     {
 325       XCONS (last_boundary)->cdr = Qnil;
 326       return list;
 327     }
 328   else
 329     return Qnil;
 330 }
 331 \f
 332 DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0,
 333   "Undo N records from the front of the list LIST.\n\
 334 Return what remains of the list.")
 335   (n, list)
 336      Lisp_Object n, list;
 337 {
 338   struct gcpro gcpro1, gcpro2;
 339   Lisp_Object next;
 340   int count = specpdl_ptr - specpdl;
 341   register int arg;
 342 #if 0  /* This is a good feature, but would make undo-start
 343           unable to do what is expected.  */
 344   Lisp_Object tem;
 345
 346   /* If the head of the list is a boundary, it is the boundary
 347      preceding this command.  Get rid of it and don't count it.  */
 348   tem = Fcar (list);
 349   if (NILP (tem))
 350     list = Fcdr (list);
 351 #endif
 352
 353   CHECK_NUMBER (n, 0);
 354   arg = XINT (n);
 355   next = Qnil;
 356   GCPRO2 (next, list);
 357
 358   /* Don't let read-only properties interfere with undo.  */
 359   if (NILP (current_buffer->read_only))
 360     specbind (Qinhibit_read_only, Qt);
 361
 362   while (arg > 0)
 363     {
 364       while (1)
 365         {
 366           next = Fcar (list);
 367           list = Fcdr (list);
 368           /* Exit inner loop at undo boundary.  */
 369           if (NILP (next))
 370             break;
 371           /* Handle an integer by setting point to that value.  */
 372           if (XTYPE (next) == Lisp_Int)
 373             SET_PT (clip_to_bounds (BEGV, XINT (next), ZV));
 374           else if (XTYPE (next) == Lisp_Cons)
 375             {
 376               Lisp_Object car, cdr;
 377
 378               car = Fcar (next);
 379               cdr = Fcdr (next);
 380               if (EQ (car, Qt))
 381                 {
 382                   /* Element (t high . low) records previous modtime.  */
 383                   Lisp_Object high, low;
 384                   int mod_time;
 385
 386                   high = Fcar (cdr);
 387                   low = Fcdr (cdr);
 388                   mod_time = (XFASTINT (high) << 16) + XFASTINT (low);
 389                   /* If this records an obsolete save
 390                      (not matching the actual disk file)
 391                      then don't mark unmodified.  */
 392                   if (mod_time != current_buffer->modtime)
 393                     break;
 394 #ifdef CLASH_DETECTION
 395                   Funlock_buffer ();
 396 #endif /* CLASH_DETECTION */
 397                   Fset_buffer_modified_p (Qnil);
 398                 }
 399 #ifdef USE_TEXT_PROPERTIES
 400               else if (EQ (car, Qnil))
 401                 {
 402                   /* Element (nil prop val beg . end) is property change.  */
 403                   Lisp_Object beg, end, prop, val;
 404
 405                   prop = Fcar (cdr);
 406                   cdr = Fcdr (cdr);
 407                   val = Fcar (cdr);
 408                   cdr = Fcdr (cdr);
 409                   beg = Fcar (cdr);
 410                   end = Fcdr (cdr);
 411
 412                   Fput_text_property (beg, end, prop, val, Qnil);
 413                 }
 414 #endif /* USE_TEXT_PROPERTIES */
 415               else if (XTYPE (car) == Lisp_Int && XTYPE (cdr) == Lisp_Int)
 416                 {
 417                   /* Element (BEG . END) means range was inserted.  */
 418                   Lisp_Object end;
 419
 420                   if (XINT (car) < BEGV
 421                       || XINT (cdr) > ZV)
 422                     error ("Changes to be undone are outside visible portion of buffer");
 423                   /* Set point first thing, so that undoing this undo
 424                      does not send point back to where it is now.  */
 425                   Fgoto_char (car);
 426                   Fdelete_region (car, cdr);
 427                 }
 428               else if (XTYPE (car) == Lisp_String && XTYPE (cdr) == Lisp_Int)
 429                 {
 430                   /* Element (STRING . POS) means STRING was deleted.  */
 431                   Lisp_Object membuf;
 432                   int pos = XINT (cdr);
 433
 434                   membuf = car;
 435                   if (pos < 0)
 436                     {
 437                       if (-pos < BEGV || -pos > ZV)
 438                         error ("Changes to be undone are outside visible portion of buffer");
 439                       SET_PT (-pos);
 440                       Finsert (1, &membuf);
 441                     }
 442                   else
 443                     {
 444                       if (pos < BEGV || pos > ZV)
 445                         error ("Changes to be undone are outside visible portion of buffer");
 446                       SET_PT (pos);
 447
 448                       /* Insert before markers so that if the mark is
 449                          currently on the boundary of this deletion, it
 450                          ends up on the other side of the now-undeleted
 451                          text from point.  Since undo doesn't even keep
 452                          track of the mark, this isn't really necessary,
 453                          but it may lead to better behavior in certain
 454                          situations.  */
 455                       Finsert_before_markers (1, &membuf);
 456                       SET_PT (pos);
 457                     }
 458                 }
 459             }
 460         }
 461       arg--;
 462     }
 463
 464   UNGCPRO;
 465   return unbind_to (count, list);
 466 }
 467
 468 syms_of_undo ()
 469 {
 470   Qinhibit_read_only = intern ("inhibit-read-only");
 471   staticpro (&Qinhibit_read_only);
 472
 473   pending_boundary = Qnil;
 474   staticpro (&pending_boundary);
 475
 476   defsubr (&Sprimitive_undo);
 477   defsubr (&Sundo_boundary);
 478 }