Initial revision

1 files changed, 322 insertions, 0 deletions

diff --git a/src/undo.c b/src/undo.c
new file mode 100644
index 00000000000..02c89f3779d
--- /dev/null
+++ b/src/undo.c
@@ -0,0 +1,322 @@
+/* undo handling for GNU Emacs.
+   Copyright (C) 1990 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY.  No author or distributor
+accepts responsibility to anyone for the consequences of using it
+or for whether it serves any particular purpose or works at all,
+unless he says so in writing.  Refer to the GNU Emacs General Public
+License for full details.
+
+Everyone is granted permission to copy, modify and redistribute
+GNU Emacs, but only under the conditions described in the
+GNU Emacs General Public License.   A copy of this license is
+supposed to have been given to you along with GNU Emacs so you
+can know your rights and responsibilities.  It should be in a
+file named COPYING.  Among other things, the copyright notice
+and this notice must be preserved on all copies.  */
+
+
+#include "config.h"
+#include "lisp.h"
+#include "buffer.h"
+
+/* Last buffer for which undo information was recorded.  */
+Lisp_Object last_undo_buffer;
+
+/* Record an insertion that just happened or is about to happen,
+   for LENGTH characters at position BEG.
+   (It is possible to record an insertion before or after the fact
+   because we don't need to record the contents.)  */
+
+record_insert (beg, length)
+     Lisp_Object beg, length;
+{
+  Lisp_Object lbeg, lend;
+
+  if (current_buffer != XBUFFER (last_undo_buffer))
+    Fundo_boundary ();
+  XSET (last_undo_buffer, Lisp_Buffer, current_buffer);
+
+  if (EQ (current_buffer->undo_list, Qt))
+    return;
+  if (MODIFF <= current_buffer->save_modified)
+    record_first_change ();
+
+  /* If this is following another insertion and consecutive with it
+     in the buffer, combine the two.  */
+  if (XTYPE (current_buffer->undo_list) == Lisp_Cons)
+    {
+      Lisp_Object elt;
+      elt = XCONS (current_buffer->undo_list)->car;
+      if (XTYPE (elt) == Lisp_Cons
+          && XTYPE (XCONS (elt)->car) == Lisp_Int
+          && XTYPE (XCONS (elt)->cdr) == Lisp_Int
+          && XINT (XCONS (elt)->cdr) == beg)
+        {
+          XSETINT (XCONS (elt)->cdr, beg + length);
+          return;
+        }
+    }
+
+  XFASTINT (lbeg) = beg;
+  XFASTINT (lend) = beg + length;
+  current_buffer->undo_list = Fcons (Fcons (lbeg, lend), current_buffer->undo_list);
+}
+
+/* Record that a deletion is about to take place,
+   for LENGTH characters at location BEG.  */
+
+record_delete (beg, length)
+     int beg, length;
+{
+  Lisp_Object lbeg, lend, sbeg;
+
+  if (current_buffer != XBUFFER (last_undo_buffer))
+    Fundo_boundary ();
+  XSET (last_undo_buffer, Lisp_Buffer, current_buffer);
+
+  if (EQ (current_buffer->undo_list, Qt))
+    return;
+  if (MODIFF <= current_buffer->save_modified)
+    record_first_change ();
+
+  if (point == beg + length)
+    XSET (sbeg, Lisp_Int, -beg);
+  else
+    XFASTINT (sbeg) = beg;
+  XFASTINT (lbeg) = beg;
+  XFASTINT (lend) = beg + length;
+  current_buffer->undo_list
+    = Fcons (Fcons (Fbuffer_substring (lbeg, lend), sbeg),
+             current_buffer->undo_list);
+}
+
+/* Record that a replacement is about to take place,
+   for LENGTH characters at location BEG.
+   The replacement does not change the number of characters.  */
+
+record_change (beg, length)
+     int beg, length;
+{
+  record_delete (beg, length);
+  record_insert (beg, length);
+}
+
+/* Record that an unmodified buffer is about to be changed.
+   Record the file modification date so that when undoing this entry
+   we can tell whether it is obsolete because the file was saved again.  */
+
+record_first_change ()
+{
+  Lisp_Object high, low;
+  XFASTINT (high) = (current_buffer->modtime >> 16) & 0xffff;
+  XFASTINT (low) = current_buffer->modtime & 0xffff;
+  current_buffer->undo_list = Fcons (Fcons (Qt, Fcons (high, low)), current_buffer->undo_list);
+}
+
+DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0,
+  "Mark a boundary between units of undo.\n\
+An undo command will stop at this point,\n\
+but another undo command will undo to the previous boundary.")
+  ()
+{
+  Lisp_Object tem;
+  if (EQ (current_buffer->undo_list, Qt))
+    return Qnil;
+  tem = Fcar (current_buffer->undo_list);
+  if (!NULL (tem))
+    current_buffer->undo_list = Fcons (Qnil, current_buffer->undo_list);
+  return Qnil;
+}
+
+/* At garbage collection time, make an undo list shorter at the end,
+   returning the truncated list.
+   MINSIZE and MAXSIZE are the limits on size allowed, as described below.
+   In practice, these are the values of undo-threshold and
+   undo-high-threshold.  */
+
+Lisp_Object
+truncate_undo_list (list, minsize, maxsize)
+     Lisp_Object list;
+     int minsize, maxsize;
+{
+  Lisp_Object prev, next, last_boundary;
+  int size_so_far = 0;
+
+  prev = Qnil;
+  next = list;
+  last_boundary = Qnil;
+
+  /* Always preserve at least the most recent undo record.
+     If the first element is an undo boundary, skip past it.  */
+  if (XTYPE (next) == Lisp_Cons
+      && XCONS (next)->car == Qnil)
+    {
+      /* Add in the space occupied by this element and its chain link.  */
+      size_so_far += sizeof (struct Lisp_Cons);
+
+      /* Advance to next element.  */
+      prev = next;
+      next = XCONS (next)->cdr;
+    }
+  while (XTYPE (next) == Lisp_Cons
+         && XCONS (next)->car != Qnil)
+    {
+      Lisp_Object elt;
+      elt = XCONS (next)->car;
+
+      /* Add in the space occupied by this element and its chain link.  */
+      size_so_far += sizeof (struct Lisp_Cons);
+      if (XTYPE (elt) == Lisp_Cons)
+        {
+          size_so_far += sizeof (struct Lisp_Cons);
+          if (XTYPE (XCONS (elt)->car) == Lisp_String)
+            size_so_far += (sizeof (struct Lisp_String) - 1
+                            + XSTRING (XCONS (elt)->car)->size);
+        }
+
+      /* Advance to next element.  */
+      prev = next;
+      next = XCONS (next)->cdr;
+    }
+  if (XTYPE (next) == Lisp_Cons)
+    last_boundary = prev;
+
+  while (XTYPE (next) == Lisp_Cons)
+    {
+      Lisp_Object elt;
+      elt = XCONS (next)->car;
+
+      /* When we get to a boundary, decide whether to truncate
+         either before or after it.  The lower threshold, MINSIZE,
+         tells us to truncate after it.  If its size pushes past
+         the higher threshold MAXSIZE as well, we truncate before it.  */
+      if (NULL (elt))
+        {
+          if (size_so_far > maxsize)
+            break;
+          last_boundary = prev;
+          if (size_so_far > minsize)
+            break;
+        }
+
+      /* Add in the space occupied by this element and its chain link.  */
+      size_so_far += sizeof (struct Lisp_Cons);
+      if (XTYPE (elt) == Lisp_Cons)
+        {
+          size_so_far += sizeof (struct Lisp_Cons);
+          if (XTYPE (XCONS (elt)->car) == Lisp_String)
+            size_so_far += (sizeof (struct Lisp_String) - 1
+                            + XSTRING (XCONS (elt)->car)->size);
+        }
+
+      /* Advance to next element.  */
+      prev = next;
+      next = XCONS (next)->cdr;
+    }
+
+  /* If we scanned the whole list, it is short enough; don't change it.  */
+  if (NULL (next))
+    return list;
+
+  /* Truncate at the boundary where we decided to truncate.  */
+  if (!NULL (last_boundary))
+    {
+      XCONS (last_boundary)->cdr = Qnil;
+      return list;
+    }
+  else
+    return Qnil;
+}
+
+DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0,
+  "Undo N records from the front of the list LIST.\n\
+Return what remains of the list.")
+  (count, list)
+     Lisp_Object count, list;
+{
+  register int arg = XINT (count);
+#if 0  /* This is a good feature, but would make undo-start
+          unable to do what is expected.  */
+  Lisp_Object tem;
+
+  /* If the head of the list is a boundary, it is the boundary
+     preceding this command.  Get rid of it and don't count it.  */
+  tem = Fcar (list);
+  if (NULL (tem))
+    list = Fcdr (list);
+#endif
+
+  while (arg > 0)
+    {
+      while (1)
+        {
+          Lisp_Object next, car, cdr;
+          next = Fcar (list);
+          list = Fcdr (list);
+          if (NULL (next))
+            break;
+          car = Fcar (next);
+          cdr = Fcdr (next);
+          if (EQ (car, Qt))
+            {
+              Lisp_Object high, low;
+              int mod_time;
+              high = Fcar (cdr);
+              low = Fcdr (cdr);
+              mod_time = (high << 16) + low;
+              /* If this records an obsolete save
+                 (not matching the actual disk file)
+                 then don't mark unmodified.  */
+              if (mod_time != current_buffer->modtime)
+                break;
+#ifdef CLASH_DETECTION
+              Funlock_buffer ();
+#endif /* CLASH_DETECTION */
+              Fset_buffer_modified_p (Qnil);
+            }
+          else if (XTYPE (car) == Lisp_Int && XTYPE (cdr) == Lisp_Int)
+            {
+              Lisp_Object end;
+              if (XINT (car) < BEGV
+                  || XINT (cdr) > ZV)
+                error ("Changes to be undone are outside visible portion of buffer");
+              Fdelete_region (car, cdr);
+              Fgoto_char (car);
+            }
+          else if (XTYPE (car) == Lisp_String && XTYPE (cdr) == Lisp_Int)
+            {
+              Lisp_Object membuf;
+              int pos = XINT (cdr);
+              membuf = car;
+              if (pos < 0)
+                {
+                  if (-pos < BEGV || -pos > ZV)
+                    error ("Changes to be undone are outside visible portion of buffer");
+                  SET_PT (-pos);
+                  Finsert (1, &membuf);
+                }
+              else
+                {
+                  if (pos < BEGV || pos > ZV)
+                    error ("Changes to be undone are outside visible portion of buffer");
+                  SET_PT (pos);
+                  Finsert (1, &membuf);
+                  SET_PT (pos);
+                }
+            }
+        }
+      arg--;
+    }
+
+  return list;
+}
+
+syms_of_undo ()
+{
+  defsubr (&Sprimitive_undo);
+  defsubr (&Sundo_boundary);
+}