* lisp/simple.el (primitive-undo): Move from undo.c.

* src/undo.c (Fprimitive_undo): Move to simple.el.
(syms_of_undo): Remove declaration for Sprimitive_undo.
* test/automated/undo-tests.el: New file.

1 files changed, 0 insertions, 212 deletions

diff --git a/src/undo.c b/src/undo.c
index 2626fd4ccfe..63edc8e9b8d 100644
--- a/src/undo.c
+++ b/src/undo.c
@@ -452,217 +452,6 @@ user_error (const char *msg)
 }
 
 
-DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0,
-       doc: /* Undo N records from the front of the list LIST.
-Return what remains of the list.  */)
-  (Lisp_Object n, Lisp_Object list)
-{
-  struct gcpro gcpro1, gcpro2;
-  Lisp_Object next;
-  ptrdiff_t count = SPECPDL_INDEX ();
-  register EMACS_INT arg;
-  Lisp_Object oldlist;
-  int did_apply = 0;
-
-#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 (NILP (tem))
-    list = Fcdr (list);
-#endif
-
-  CHECK_NUMBER (n);
-  arg = XINT (n);
-  next = Qnil;
-  GCPRO2 (next, list);
-  /* I don't think we need to gcpro oldlist, as we use it only
-     to check for EQ.  ++kfs  */
-
-  /* In a writable buffer, enable undoing read-only text that is so
-     because of text properties.  */
-  if (NILP (BVAR (current_buffer, read_only)))
-    specbind (Qinhibit_read_only, Qt);
-
-  /* Don't let `intangible' properties interfere with undo.  */
-  specbind (Qinhibit_point_motion_hooks, Qt);
-
-  oldlist = BVAR (current_buffer, undo_list);
-
-  while (arg > 0)
-    {
-      while (CONSP (list))
-	{
-	  next = XCAR (list);
-	  list = XCDR (list);
-	  /* Exit inner loop at undo boundary.  */
-	  if (NILP (next))
-	    break;
-	  /* Handle an integer by setting point to that value.  */
-	  if (INTEGERP (next))
-	    SET_PT (clip_to_bounds (BEGV, XINT (next), ZV));
-	  else if (CONSP (next))
-	    {
-	      Lisp_Object car, cdr;
-
-	      car = XCAR (next);
-	      cdr = XCDR (next);
-	      if (EQ (car, Qt))
-		{
-		  /* Element (t . TIME) records previous modtime.
-		     Preserve any flag of NONEXISTENT_MODTIME_NSECS or
-		     UNKNOWN_MODTIME_NSECS.  */
-		  struct buffer *base_buffer = current_buffer;
-		  EMACS_TIME mod_time;
-
-		  if (CONSP (cdr)
-		      && CONSP (XCDR (cdr))
-		      && CONSP (XCDR (XCDR (cdr)))
-		      && CONSP (XCDR (XCDR (XCDR (cdr))))
-		      && INTEGERP (XCAR (XCDR (XCDR (XCDR (cdr)))))
-		      && XINT (XCAR (XCDR (XCDR (XCDR (cdr))))) < 0)
-		    mod_time =
-		      (make_emacs_time
-		       (0, XINT (XCAR (XCDR (XCDR (XCDR (cdr))))) / 1000));
-		  else
-		    mod_time = lisp_time_argument (cdr);
-
-		  if (current_buffer->base_buffer)
-		    base_buffer = current_buffer->base_buffer;
-
-		  /* If this records an obsolete save
-		     (not matching the actual disk file)
-		     then don't mark unmodified.  */
-		  if (EMACS_TIME_NE (mod_time, base_buffer->modtime))
-		    continue;
-#ifdef CLASH_DETECTION
-		  Funlock_buffer ();
-#endif /* CLASH_DETECTION */
-		  Fset_buffer_modified_p (Qnil);
-		}
-	      else if (EQ (car, Qnil))
-		{
-		  /* Element (nil PROP VAL BEG . END) is property change.  */
-		  Lisp_Object beg, end, prop, val;
-
-		  prop = Fcar (cdr);
-		  cdr = Fcdr (cdr);
-		  val = Fcar (cdr);
-		  cdr = Fcdr (cdr);
-		  beg = Fcar (cdr);
-		  end = Fcdr (cdr);
-
-		  if (XINT (beg) < BEGV || XINT (end) > ZV)
-		    user_error ("Changes to be undone are outside visible portion of buffer");
-		  Fput_text_property (beg, end, prop, val, Qnil);
-		}
-	      else if (INTEGERP (car) && INTEGERP (cdr))
-		{
-		  /* Element (BEG . END) means range was inserted.  */
-
-		  if (XINT (car) < BEGV
-		      || XINT (cdr) > ZV)
-		    user_error ("Changes to be undone are outside visible portion of buffer");
-		  /* Set point first thing, so that undoing this undo
-		     does not send point back to where it is now.  */
-		  Fgoto_char (car);
-		  Fdelete_region (car, cdr);
-		}
-	      else if (EQ (car, Qapply))
-		{
-		  /* Element (apply FUN . ARGS) means call FUN to undo.  */
-		  struct buffer *save_buffer = current_buffer;
-
-		  car = Fcar (cdr);
-		  cdr = Fcdr (cdr);
-		  if (INTEGERP (car))
-		    {
-		      /* Long format: (apply DELTA START END FUN . ARGS).  */
-		      Lisp_Object delta = car;
-		      Lisp_Object start = Fcar (cdr);
-		      Lisp_Object end   = Fcar (Fcdr (cdr));
-		      Lisp_Object start_mark = Fcopy_marker (start, Qnil);
-		      Lisp_Object end_mark   = Fcopy_marker (end, Qt);
-
-		      cdr = Fcdr (Fcdr (cdr));
-		      apply1 (Fcar (cdr), Fcdr (cdr));
-
-		      /* Check that the function did what the entry said it
-			 would do.  */
-		      if (!EQ (start, Fmarker_position (start_mark))
-			  || (XINT (delta) + XINT (end)
-			      != marker_position (end_mark)))
-			error ("Changes to be undone by function different than announced");
-		      Fset_marker (start_mark, Qnil, Qnil);
-		      Fset_marker (end_mark, Qnil, Qnil);
-		    }
-		  else
-		    apply1 (car, cdr);
-
-		  if (save_buffer != current_buffer)
-		    error ("Undo function switched buffer");
-		  did_apply = 1;
-		}
-	      else if (STRINGP (car) && INTEGERP (cdr))
-		{
-		  /* Element (STRING . POS) means STRING was deleted.  */
-		  Lisp_Object membuf;
-		  EMACS_INT pos = XINT (cdr);
-
-		  membuf = car;
-		  if (pos < 0)
-		    {
-		      if (-pos < BEGV || -pos > ZV)
-			user_error ("Changes to be undone are outside visible portion of buffer");
-		      SET_PT (-pos);
-		      Finsert (1, &membuf);
-		    }
-		  else
-		    {
-		      if (pos < BEGV || pos > ZV)
-			user_error ("Changes to be undone are outside visible portion of buffer");
-		      SET_PT (pos);
-
-		      /* Now that we record marker adjustments
-			 (caused by deletion) for undo,
-			 we should always insert after markers,
-			 so that undoing the marker adjustments
-			 put the markers back in the right place.  */
-		      Finsert (1, &membuf);
-		      SET_PT (pos);
-		    }
-		}
-	      else if (MARKERP (car) && INTEGERP (cdr))
-		{
-		  /* (MARKER . INTEGER) means a marker MARKER
-		     was adjusted by INTEGER.  */
-		  if (XMARKER (car)->buffer)
-		    Fset_marker (car,
-				 make_number (marker_position (car) - XINT (cdr)),
-				 Fmarker_buffer (car));
-		}
-	    }
-	}
-      arg--;
-    }
-
-
-  /* Make sure an apply entry produces at least one undo entry,
-     so the test in `undo' for continuing an undo series
-     will work right.  */
-  if (did_apply
-      && EQ (oldlist, BVAR (current_buffer, undo_list)))
-    bset_undo_list
-      (current_buffer,
-       Fcons (list3 (Qapply, Qcdr, Qnil), BVAR (current_buffer, undo_list)));
-
-  UNGCPRO;
-  return unbind_to (count, list);
-}
-
 void
 syms_of_undo (void)
 {
@@ -675,7 +464,6 @@ syms_of_undo (void)
   last_undo_buffer = NULL;
   last_boundary_buffer = NULL;
 
-  defsubr (&Sprimitive_undo);
   defsubr (&Sundo_boundary);
 
   DEFVAR_INT ("undo-limit", undo_limit,