(sxhash): As far as possible, merge calculation of

[gnu-emacs] / src / undo.c

diff --git a/src/undo.c b/src/undo.c
index 40cebbac6ed1f35b2efac6f837c6937a3314a7d8..9fdc46a3b13112684fb926f48098dfd8e56fef93 100644 (file)
--- a/src/undo.c
+++ b/src/undo.c
@@ -36,6 +36,62 @@ Lisp_Object Qinhibit_read_only;
    an undo-boundary.  */
 Lisp_Object pending_boundary;
 
    an undo-boundary.  */
 Lisp_Object pending_boundary;
 

+/* Record point as it was at beginning of this command (if necessary)
+   And prepare the undo info for recording a change.
+   PT is the position of point that will naturally occur as a result of the
+   undo record that will be added just after this command terminates.  */
+
+static void
+record_point (pt)
+     int pt;
+{
+  int at_boundary;
+
+  /* Allocate a cons cell to be the undo boundary after this command.  */
+  if (NILP (pending_boundary))
+    pending_boundary = Fcons (Qnil, Qnil);
+
+  if (!BUFFERP (last_undo_buffer)
+      || current_buffer != XBUFFER (last_undo_buffer))
+    Fundo_boundary ();
+  XSETBUFFER (last_undo_buffer, current_buffer);
+
+  if (CONSP (current_buffer->undo_list))
+    {
+      /* Set AT_BOUNDARY to 1 only when we have nothing other than
+         marker adjustment before undo boundary.  */
+
+      Lisp_Object tail = current_buffer->undo_list, elt;
+
+      while (1)
+       {
+         if (NILP (tail))
+           elt = Qnil;
+         else
+           elt = XCAR (tail);
+         if (NILP (elt) || ! (CONSP (elt) && MARKERP (XCAR (elt))))
+           break;
+         tail = XCDR (tail);
+       }
+      at_boundary = NILP (elt);
+    }
+  else
+    at_boundary = 1;
+
+  if (MODIFF <= SAVE_MODIFF)
+    record_first_change ();
+
+  /* If we are just after an undo boundary, and
+     point wasn't at start of deleted range, record where it was.  */
+  if (at_boundary
+      && last_point_position != pt
+      /* If we're called from batch mode, this could be nil.  */
+      && BUFFERP (last_point_position_buffer)
+      && current_buffer == XBUFFER (last_point_position_buffer))
+    current_buffer->undo_list
+      = Fcons (make_number (last_point_position), current_buffer->undo_list);
+}
+

 /* 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
 /* 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


@@ -50,17 +106,7 @@ record_insert (beg, length)
   if (EQ (current_buffer->undo_list, Qt))
     return;
 
   if (EQ (current_buffer->undo_list, Qt))
     return;
 

-  /* Allocate a cons cell to be the undo boundary after this command.  */
-  if (NILP (pending_boundary))
-    pending_boundary = Fcons (Qnil, Qnil);
-
-  if (!BUFFERP (last_undo_buffer)
-      || current_buffer != XBUFFER (last_undo_buffer))
-    Fundo_boundary ();
-  XSETBUFFER (last_undo_buffer, current_buffer);
-
-  if (MODIFF <= SAVE_MODIFF)
-    record_first_change ();
+  record_point (beg);

 
   /* If this is following another insertion and consecutive with it
      in the buffer, combine the two.  */
 
   /* If this is following another insertion and consecutive with it
      in the buffer, combine the two.  */


@@ -73,7 +119,7 @@ record_insert (beg, length)
          && INTEGERP (XCDR (elt))
          && XINT (XCDR (elt)) == beg)
        {
          && INTEGERP (XCDR (elt))
          && XINT (XCDR (elt)) == beg)
        {

-         XSETINT (XCDR (elt), beg + length);
+         XSETCDR (elt, make_number (beg + length));

          return;
        }
     }
          return;
        }
     }


@@ -93,59 +139,20 @@ record_delete (beg, string)
      Lisp_Object string;
 {
   Lisp_Object sbeg;
      Lisp_Object string;
 {
   Lisp_Object sbeg;

-  int at_boundary;

 
   if (EQ (current_buffer->undo_list, Qt))
     return;
 
 
   if (EQ (current_buffer->undo_list, Qt))
     return;
 

-  /* Allocate a cons cell to be the undo boundary after this command.  */
-  if (NILP (pending_boundary))
-    pending_boundary = Fcons (Qnil, Qnil);
-
-  if (BUFFERP (last_undo_buffer)
-      && current_buffer != XBUFFER (last_undo_buffer))
-    Fundo_boundary ();
-  XSETBUFFER (last_undo_buffer, current_buffer);
-
-  if (CONSP (current_buffer->undo_list))
+  if (PT == beg + SCHARS (string))

     {
     {

-      /* Set AT_BOUNDARY to 1 only when we have nothing other than
-         marker adjustment before undo boundary.  */
-
-      Lisp_Object tail = current_buffer->undo_list, elt;
-
-      while (1)
-       {
-         if (NILP (tail))
-           elt = Qnil;
-         else
-           elt = XCAR (tail);
-         if (NILP (elt) || ! (CONSP (elt) && MARKERP (XCAR (elt))))
-           break;
-         tail = XCDR (tail);
-       }
-      at_boundary = NILP (elt);
+      XSETINT (sbeg, -beg);
+      record_point (PT);

     }
   else
     }
   else

-    at_boundary = 0;
-
-  if (MODIFF <= SAVE_MODIFF)
-    record_first_change ();
-
-  if (PT == beg + XSTRING (string)->size)
-    XSETINT (sbeg, -beg);
-  else
-    XSETFASTINT (sbeg, beg);
-
-  /* If we are just after an undo boundary, and 
-     point wasn't at start of deleted range, record where it was.  */
-  if (at_boundary
-      && last_point_position != XFASTINT (sbeg)
-      /* If we're called from batch mode, this could be nil.  */
-      && BUFFERP (last_point_position_buffer)
-      && current_buffer == XBUFFER (last_point_position_buffer))
-    current_buffer->undo_list
-      = Fcons (make_number (last_point_position), current_buffer->undo_list);
+    {
+      XSETFASTINT (sbeg, beg);
+      record_point (beg);
+    }

 
   current_buffer->undo_list
     = Fcons (Fcons (string, sbeg), current_buffer->undo_list);
 
   current_buffer->undo_list
     = Fcons (Fcons (string, sbeg), current_buffer->undo_list);


@@ -168,7 +175,7 @@ record_marker_adjustment (marker, adjustment)
   if (NILP (pending_boundary))
     pending_boundary = Fcons (Qnil, Qnil);
 
   if (NILP (pending_boundary))
     pending_boundary = Fcons (Qnil, Qnil);
 

-  if (!BUFFERP (last_undo_buffer) 
+  if (!BUFFERP (last_undo_buffer)

       || current_buffer != XBUFFER (last_undo_buffer))
     Fundo_boundary ();
   XSETBUFFER (last_undo_buffer, current_buffer);
       || current_buffer != XBUFFER (last_undo_buffer))
     Fundo_boundary ();
   XSETBUFFER (last_undo_buffer, current_buffer);


@@ -257,10 +264,10 @@ record_property_change (beg, length, prop, value, buffer)
 }
 
 DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0,
 }
 
 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.")
-  ()
+       doc: /* Mark a boundary between units of undo.
+An undo command will stop at this point,
+but another undo command will undo to the previous boundary.  */)
+     ()

 {
   Lisp_Object tem;
   if (EQ (current_buffer->undo_list, Qt))
 {
   Lisp_Object tem;
   if (EQ (current_buffer->undo_list, Qt))


@@ -273,7 +280,7 @@ but another undo command will undo to the previous boundary.")
        {
          /* If we have preallocated the cons cell to use here,
             use that one.  */
        {
          /* If we have preallocated the cons cell to use here,
             use that one.  */

-         XCDR (pending_boundary) = current_buffer->undo_list;
+         XSETCDR (pending_boundary, current_buffer->undo_list);

          current_buffer->undo_list = pending_boundary;
          pending_boundary = Qnil;
        }
          current_buffer->undo_list = pending_boundary;
          pending_boundary = Qnil;
        }


@@ -285,14 +292,15 @@ but another undo command will undo to the previous boundary.")
 
 /* At garbage collection time, make an undo list shorter at the end,
    returning the truncated list.
 
 /* 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-limit and
-   undo-strong-limit.  */
+   MINSIZE, MAXSIZE and LIMITSIZE are the limits on size allowed,
+   as described below.
+   In practice, these are the values of undo-limit,
+   undo-strong-limit, and undo-outer-limit.  */

 
 Lisp_Object
 
 Lisp_Object

-truncate_undo_list (list, minsize, maxsize)
+truncate_undo_list (list, minsize, maxsize, limitsize)

      Lisp_Object list;
      Lisp_Object list;

-     int minsize, maxsize;
+     int minsize, maxsize, limitsize;

 {
   Lisp_Object prev, next, last_boundary;
   int size_so_far = 0;
 {
   Lisp_Object prev, next, last_boundary;
   int size_so_far = 0;


@@ -301,11 +309,12 @@ truncate_undo_list (list, minsize, maxsize)
   next = list;
   last_boundary = Qnil;
 
   next = list;
   last_boundary = Qnil;
 

-  /* Always preserve at least the most recent undo record.
+  /* Always preserve at least the most recent undo record
+     unless it is really horribly big.

      If the first element is an undo boundary, skip past it.
 
      Skip, skip, skip the undo, skip, skip, skip the undo,
      If the first element is an undo boundary, skip past it.
 
      Skip, skip, skip the undo, skip, skip, skip the undo,

-     Skip, skip, skip the undo, skip to the undo bound'ry. 
+     Skip, skip, skip the undo, skip to the undo bound'ry.

      (Get it?  "Skip to my Loo?")  */
   if (CONSP (next) && NILP (XCAR (next)))
     {
      (Get it?  "Skip to my Loo?")  */
   if (CONSP (next) && NILP (XCAR (next)))
     {


@@ -316,6 +325,7 @@ truncate_undo_list (list, minsize, maxsize)
       prev = next;
       next = XCDR (next);
     }
       prev = next;
       next = XCDR (next);
     }

+

   while (CONSP (next) && ! NILP (XCAR (next)))
     {
       Lisp_Object elt;
   while (CONSP (next) && ! NILP (XCAR (next)))
     {
       Lisp_Object elt;


@@ -328,16 +338,23 @@ truncate_undo_list (list, minsize, maxsize)
          size_so_far += sizeof (struct Lisp_Cons);
          if (STRINGP (XCAR (elt)))
            size_so_far += (sizeof (struct Lisp_String) - 1
          size_so_far += sizeof (struct Lisp_Cons);
          if (STRINGP (XCAR (elt)))
            size_so_far += (sizeof (struct Lisp_String) - 1

-                           + XSTRING (XCAR (elt))->size);
+                           + SCHARS (XCAR (elt)));

        }
 
        }
 

+      /* If we reach LIMITSIZE before the first boundary,
+        we're heading for memory full, so truncate the list to nothing.  */
+      if (size_so_far > limitsize)
+       return Qnil;
+

       /* Advance to next element.  */
       prev = next;
       next = XCDR (next);
     }
       /* Advance to next element.  */
       prev = next;
       next = XCDR (next);
     }

+

   if (CONSP (next))
     last_boundary = prev;
 
   if (CONSP (next))
     last_boundary = prev;
 

+  /* Keep more if it fits.  */

   while (CONSP (next))
     {
       Lisp_Object elt;
   while (CONSP (next))
     {
       Lisp_Object elt;


@@ -363,7 +380,7 @@ truncate_undo_list (list, minsize, maxsize)
          size_so_far += sizeof (struct Lisp_Cons);
          if (STRINGP (XCAR (elt)))
            size_so_far += (sizeof (struct Lisp_String) - 1
          size_so_far += sizeof (struct Lisp_Cons);
          if (STRINGP (XCAR (elt)))
            size_so_far += (sizeof (struct Lisp_String) - 1

-                           + XSTRING (XCAR (elt))->size);
+                           + SCHARS (XCAR (elt)));

        }
 
       /* Advance to next element.  */
        }
 
       /* Advance to next element.  */


@@ -378,7 +395,7 @@ truncate_undo_list (list, minsize, maxsize)
   /* Truncate at the boundary where we decided to truncate.  */
   if (!NILP (last_boundary))
     {
   /* Truncate at the boundary where we decided to truncate.  */
   if (!NILP (last_boundary))
     {

-      XCDR (last_boundary) = Qnil;
+      XSETCDR (last_boundary, Qnil);

       return list;
     }
   else
       return list;
     }
   else


@@ -386,16 +403,16 @@ truncate_undo_list (list, minsize, maxsize)
 }
 \f
 DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0,
 }
 \f
 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.")
-  (n, list)
+       doc: /* Undo N records from the front of the list LIST.
+Return what remains of the list.  */)
+     (n, list)

      Lisp_Object n, list;
 {
   struct gcpro gcpro1, gcpro2;
   Lisp_Object next;
      Lisp_Object n, list;
 {
   struct gcpro gcpro1, gcpro2;
   Lisp_Object next;

-  int count = BINDING_STACK_SIZE ();
+  int count = SPECPDL_INDEX ();

   register int arg;
   register int arg;

-  
+

 #if 0  /* This is a good feature, but would make undo-start
          unable to do what is expected.  */
   Lisp_Object tem;
 #if 0  /* This is a good feature, but would make undo-start
          unable to do what is expected.  */
   Lisp_Object tem;


@@ -407,13 +424,14 @@ Return what remains of the list.")
     list = Fcdr (list);
 #endif
 
     list = Fcdr (list);
 #endif
 

-  CHECK_NUMBER (n, 0);
+  CHECK_NUMBER (n);

   arg = XINT (n);
   next = Qnil;
   GCPRO2 (next, list);
 
   arg = XINT (n);
   next = Qnil;
   GCPRO2 (next, list);
 

-  /* Don't let read-only properties interfere with undo.  */
-  if (!NILP (current_buffer->read_only))
+  /* In a writable buffer, enable undoing read-only text that is so
+     because of text properties.  */
+  if (NILP (current_buffer->read_only))

     specbind (Qinhibit_read_only, Qt);
 
   /* Don't let `intangible' properties interfere with undo.  */
     specbind (Qinhibit_read_only, Qt);
 
   /* Don't let `intangible' properties interfere with undo.  */


@@ -421,10 +439,10 @@ Return what remains of the list.")
 
   while (arg > 0)
     {
 
   while (arg > 0)
     {

-      while (1)
+      while (CONSP (list))

        {
        {

-         next = Fcar (list);
-         list = Fcdr (list);
+         next = XCAR (list);
+         list = XCDR (list);

          /* Exit inner loop at undo boundary.  */
          if (NILP (next))
            break;
          /* Exit inner loop at undo boundary.  */
          if (NILP (next))
            break;


@@ -435,8 +453,8 @@ Return what remains of the list.")
            {
              Lisp_Object car, cdr;
 
            {
              Lisp_Object car, cdr;
 

-             car = Fcar (next);
-             cdr = Fcdr (next);
+             car = XCAR (next);
+             cdr = XCDR (next);

              if (EQ (car, Qt))
                {
                  /* Element (t high . low) records previous modtime.  */
              if (EQ (car, Qt))
                {
                  /* Element (t high . low) records previous modtime.  */


@@ -478,7 +496,6 @@ Return what remains of the list.")
              else if (INTEGERP (car) && INTEGERP (cdr))
                {
                  /* Element (BEG . END) means range was inserted.  */
              else if (INTEGERP (car) && INTEGERP (cdr))
                {
                  /* Element (BEG . END) means range was inserted.  */

-                 Lisp_Object end;

 
                  if (XINT (car) < BEGV
                      || XINT (cdr) > ZV)
 
                  if (XINT (car) < BEGV
                      || XINT (cdr) > ZV)


@@ -547,3 +564,6 @@ syms_of_undo ()
   defsubr (&Sprimitive_undo);
   defsubr (&Sundo_boundary);
 }
   defsubr (&Sprimitive_undo);
   defsubr (&Sundo_boundary);
 }

+
+/* arch-tag: d546ee01-4aed-4ffb-bb8b-eefaae50d38a
+   (do not change this comment) */