xemacs-beta: src/undo.c comparison

comparison src/undo.c @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14

author	cvs
date	Mon, 13 Aug 2007 08:45:50 +0200
parents
children	0293115a14e9

comparison

equal deleted inserted replaced

--1:000000000000
+:376386a54a3c
+/* undo handling for XEmacs.
+Copyright (C) 1990, 1992, 1993, 1994 Free Software Foundation, Inc.
+This file is part of XEmacs.
+XEmacs is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2, or (at your option) any
+later version.
+XEmacs is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+You should have received a copy of the GNU General Public License
+along with XEmacs; see the file COPYING.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+/* Synched up with: FSF 19.28. */
+/* This file has been Mule-ized. */
+#include <config.h>
+#include "lisp.h"
+#include "buffer.h"
+#include "extents.h"
+/* Maintained in event-stream.c */
+extern Bufpos last_point_position;
+extern Lisp_Object last_point_position_buffer;
+/* Extent code needs to know about undo because the behavior of insert()
+with regard to extents varies depending on whether we are inside
+an undo or not. */
+int inside_undo;
+/* Last buffer for which undo information was recorded.  */
+static Lisp_Object last_undo_buffer;
+Lisp_Object Qinhibit_read_only;
+/* The first time a command records something for undo.
+it also allocates the undo-boundary object
+which will be added to the list at the end of the command.
+This ensures we can't run out of space while trying to make
+an undo-boundary.  */
+Lisp_Object pending_boundary;
+static void
+undo_boundary (struct buffer *b)
+{
+Lisp_Object tem = Fcar (b->undo_list);
+if (!NILP (tem))
+{
+/* One way or another, cons nil onto the front of the undo list.  */
+if (CONSP (pending_boundary))
+	{
+	  /* If we have preallocated the cons cell to use here,
+	     use that one.  */
+	  XCDR (pending_boundary) = b->undo_list;
+	  b->undo_list = pending_boundary;
+	  pending_boundary = Qnil;
+	}
+else
+	b->undo_list = Fcons (Qnil, b->undo_list);
+}
+}
+static int
+undo_prelude (struct buffer *b, int hack_pending_boundary)
+{
+if (EQ (b->undo_list, Qt))
+return (0);
+if (NILP (last_undo_buffer) || b != XBUFFER (last_undo_buffer))
+{
+undo_boundary (b);
+XSETBUFFER (last_undo_buffer, b);
+}
+/* Allocate a cons cell to be the undo boundary after this command.  */
+if (hack_pending_boundary && NILP (pending_boundary))
+pending_boundary = Fcons (Qnil, Qnil);
+if (BUF_MODIFF (b) <= BUF_SAVE_MODIFF (b))
+{
+/* 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.  */
+b->undo_list
+= Fcons (Fcons (Qt,
+Fcons (make_int ((b->modtime >> 16) & 0xffff),
+make_int (b->modtime & 0xffff))),
+b->undo_list);
+}
+return (1);
+}
+static Lisp_Object
+restore_inside_undo (Lisp_Object val)
+{
+inside_undo = XINT (val);
+return val;
+}
+/* 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.)  */
+void
+record_insert (struct buffer *b, Bufpos beg, Charcount length)
+{
+if (!undo_prelude (b, 1))
+return;
+/* If this is following another insertion and consecutive with it
+in the buffer, combine the two.  */
+if (CONSP (b->undo_list))
+{
+Lisp_Object elt;
+elt = XCAR (b->undo_list);
+if (CONSP (elt)
+	  && INTP (XCAR (elt))
+	  && INTP (XCDR (elt))
+	  && XINT (XCDR (elt)) == beg)
+	{
+	  XCDR (elt) = make_int (beg + length);
+	  return;
+	}
+}
+b->undo_list = Fcons (Fcons (make_int (beg),
+make_int (beg + length)),
+b->undo_list);
+}
+/* Record that a deletion is about to take place,
+for LENGTH characters at location BEG.  */
+#ifdef ENERGIZE
+extern int inside_parse_buffer; /* total kludge */
+#endif
+void
+record_delete (struct buffer *b, Bufpos beg, Charcount length)
+{
+/* This function can GC */
+Lisp_Object sbeg;
+int at_boundary;
+#ifdef ENERGIZE
+/* #### why is this necessary? */
+if (inside_parse_buffer)
+return;
+#endif
+if (!undo_prelude (b, 1))
+return;
+at_boundary = (CONSP (b->undo_list)
+		 && NILP (XCAR (b->undo_list)));
+if (BUF_PT (b) == beg + length)
+sbeg = make_int (-beg);
+else
+sbeg = make_int (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
+&& BUFFERP (last_point_position_buffer)
+&& b == XBUFFER (last_point_position_buffer)
+&& last_point_position != XINT (sbeg))
+b->undo_list = Fcons (make_int (last_point_position), b->undo_list);
+b->undo_list = Fcons (Fcons (make_string_from_buffer (b, beg,
+							length),
+sbeg),
+b->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.  */
+void
+record_change (struct buffer *b, Bufpos beg, Charcount length)
+{
+record_delete (b, beg, length);
+record_insert (b, beg, length);
+}
+/* Record that an EXTENT is about to be attached or detached in its buffer.
+This works much like a deletion or insertion, except that there's no string.
+The tricky part is that the buffer we operate on comes from EXTENT.
+Most extent changes happen as a side effect of string insertion and
+deletion; this call is solely for Fdetach_extent() and Finsert_extent().
+*/
+void
+record_extent (Lisp_Object extent, int attached)
+{
+Lisp_Object buffer = Fextent_object (extent);
+struct buffer *b = XBUFFER (buffer); /* !!#### */
+Lisp_Object token;
+if (!undo_prelude (b, 1))
+return;
+if (attached)
+token = extent;
+else
+token = list3 (extent, Fextent_start_position (extent),
+		   Fextent_end_position (extent));
+b->undo_list = Fcons (token, b->undo_list);
+}
+#if 0 /* FSFmacs */
+/* Record a change in property PROP (whose old value was VAL)
+for LENGTH characters starting at position BEG in BUFFER.  */
+record_property_change (Bufpos beg, Charcount length,
+Lisp_Object prop, Lisp_Object value,
+Lisp_Object buffer)
+{
+Lisp_Object lbeg, lend, entry;
+struct buffer *b = XBUFFER (buffer);
+if (!undo_prelude (b, 1))
+return;
+lbeg = make_int (beg);
+lend = make_int (beg + length);
+entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend))));
+b->undo_list = Fcons (entry, b->undo_list);
+}
+#endif /* FSFmacs */
+DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0 /*
+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.
+*/ )
+()
+{
+if (EQ (current_buffer->undo_list, Qt))
+return Qnil;
+undo_boundary (current_buffer);
+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 (Lisp_Object list, int minsize, int maxsize)
+{
+Lisp_Object prev, next, last_boundary;
+int size_so_far = 0;
+if (!(minsize > 0 || maxsize > 0))
+return list;
+prev = Qnil;
+next = list;
+last_boundary = Qnil;
+if (!CONSP (list))
+return (list);
+/* Always preserve at least the most recent undo record.
+If the first element is an undo boundary, skip past it. */
+if (CONSP (next)
+&& NILP (XCAR (next)))
+{
+/* 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 = XCDR (next);
+}
+while (CONSP (next)
+	 && !NILP (XCAR (next)))
+{
+Lisp_Object elt;
+elt = XCAR (next);
+/* Add in the space occupied by this element and its chain link.  */
+size_so_far += sizeof (struct Lisp_Cons);
+if (CONSP (elt))
+	{
+	  size_so_far += sizeof (struct Lisp_Cons);
+	  if (STRINGP (XCAR (elt)))
+	    size_so_far += (sizeof (struct Lisp_String) - 1
+			    + string_length (XSTRING (XCAR (elt))));
+	}
+/* Advance to next element.  */
+prev = next;
+next = XCDR (next);
+}
+if (CONSP (next))
+last_boundary = prev;
+while (CONSP (next))
+{
+Lisp_Object elt;
+elt = XCAR (next);
+/* 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 (NILP (elt))
+	{
+	  if (size_so_far > maxsize && maxsize > 0)
+	    break;
+	  last_boundary = prev;
+	  if (size_so_far > minsize && minsize > 0)
+	    break;
+	}
+/* Add in the space occupied by this element and its chain link.  */
+size_so_far += sizeof (struct Lisp_Cons);
+if (CONSP (elt))
+	{
+	  size_so_far += sizeof (struct Lisp_Cons);
+	  if (STRINGP (XCAR (elt)))
+	    size_so_far += (sizeof (struct Lisp_String) - 1
++ string_length (XSTRING (XCAR (elt))));
+	}
+/* Advance to next element.  */
+prev = next;
+next = XCDR (next);
+}
+/* If we scanned the whole list, it is short enough; don't change it.  */
+if (NILP (next))
+return list;
+/* Truncate at the boundary where we decided to truncate.  */
+if (!NILP (last_boundary))
+{
+XCDR (last_boundary) = Qnil;
+return list;
+}
+else
+return Qnil;
+}
+DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0 /*
+Undo COUNT records from the front of the list LIST.
+Return what remains of the list.
+*/ )
+(count, list)
+Lisp_Object count, list;
+{
+struct gcpro gcpro1, gcpro2;
+Lisp_Object next = Qnil;
+/* This function can GC */
+int arg;
+int speccount = specpdl_depth ();
+record_unwind_protect (restore_inside_undo, make_int (inside_undo));
+inside_undo = 1;
+#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_INT (count);
+arg = XINT (count);
+next = Qnil;
+GCPRO2 (next, list);
+/* Don't let read-only properties interfere with undo.  */
+if (NILP (current_buffer->read_only))
+specbind (Qinhibit_read_only, Qt);
+while (arg > 0)
+{
+while (1)
+	{
+if (NILP (list))
+break;
+else if (!CONSP (list))
+goto rotten;
+	  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.  */
+	  else if (INTP (next))
+	    BUF_SET_PT (current_buffer,
+			bufpos_clip_to_bounds (BUF_BEGV (current_buffer),
+					       XINT (next),
+					       BUF_ZV (current_buffer)));
+	  else if (CONSP (next))
+	    {
+	      Lisp_Object car = XCAR (next);
+Lisp_Object cdr = XCDR (next);
+if (EQ (car, Qt))
+		{
+		  /* Element (t high . low) records previous modtime.  */
+		  Lisp_Object high, low;
+		  int mod_time;
+		  if (!CONSP (cdr)) goto rotten;
+		  high = XCAR (cdr);
+		  low = XCDR (cdr);
+		  if (!INTP (high) || !INTP (low)) goto rotten;
+		  mod_time = (XINT (high) << 16) + XINT (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, Fcurrent_buffer ()); /* may GC under ENERGIZE */
+		}
+	      else if (EXTENTP (car))
+		{
+		  /* Element (extent start end) means that EXTENT was
+		     detached, and we need to reattach it. */
+		  Lisp_Object extent_obj, start, end;
+		  extent_obj = car;
+		  start = Fcar (cdr);
+		  end = Fcar (Fcdr (cdr));
+		  if (!INTP (start) || !INTP (end))
+		    goto rotten;
+		  Fset_extent_endpoints (extent_obj, start, end,
+					 Fcurrent_buffer ());
+		}
+#if 0 /* FSFmacs */
+	      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);
+		  Fput_text_property (beg, end, prop, val, Qnil);
+		}
+#endif /* FSFmacs */
+	      else if (INTP (car) && INTP (cdr))
+		{
+		  /* Element (BEG . END) means range was inserted.  */
+		  if (XINT (car) < BUF_BEGV (current_buffer)
+		      || XINT (cdr) > BUF_ZV (current_buffer))
+		    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, Fcurrent_buffer ());
+		  Fdelete_region (car, cdr, Fcurrent_buffer ());
+		}
+	      else if (STRINGP (car) && INTP (cdr))
+		{
+		  /* Element (STRING . POS) means STRING was deleted.  */
+		  Lisp_Object membuf = car;
+		  int pos = XINT (cdr);
+		  if (pos < 0)
+		    {
+		      if (-pos < BUF_BEGV (current_buffer) || -pos > BUF_ZV (current_buffer))
+			error ("Changes to be undone are outside visible portion of buffer");
+		      BUF_SET_PT (current_buffer, -pos);
+		      Finsert (1, &membuf);
+		    }
+		  else
+		    {
+		      if (pos < BUF_BEGV (current_buffer) || pos > BUF_ZV (current_buffer))
+			error ("Changes to be undone are outside visible portion of buffer");
+		      BUF_SET_PT (current_buffer, pos);
+		      /* Insert before markers so that if the mark is
+			 currently on the boundary of this deletion, it
+			 ends up on the other side of the now-undeleted
+			 text from point.  Since undo doesn't even keep
+			 track of the mark, this isn't really necessary,
+			 but it may lead to better behavior in certain
+			 situations.
+			 I'm doubtful that this is safe; you could mess
+			 up the process-output mark in shell buffers, so
+			 until I hear a compelling reason for this change,
+			 I'm leaving it out. -jwz
+			 */
+		      /* Finsert_before_markers (1, &membuf); */
+		      Finsert (1, &membuf);
+		      BUF_SET_PT (current_buffer, pos);
+		    }
+		}
+	      else
+		{
+		  goto rotten;
+		}
+	    }
+	  else if (EXTENTP (next))
+	    Fdetach_extent (next);
+else
+	    {
+	    rotten:
+	      signal_simple_continuable_error
+		("Something rotten in the state of undo:", next);
+	    }
+}
+arg--;
+}
+UNGCPRO;
+return unbind_to (speccount, list);
+}
+void
+syms_of_undo (void)
+{
+defsubr (&Sprimitive_undo);
+defsubr (&Sundo_boundary);
+defsymbol (&Qinhibit_read_only, "inhibit-read-only");
+}
+void
+vars_of_undo (void)
+{
+inside_undo = 0;
+pending_boundary = Qnil;
+staticpro (&pending_boundary);
+last_undo_buffer = Qnil;
+staticpro (&last_undo_buffer);
+}

Mercurial > hg > xemacs-beta

comparison src/undo.c @ 0:376386a54a3c r19-14