X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/d8552b2f30fad04bf1fb531cabcced4afaf28bcc..c7b6dfa6df76885853be8cadf06d8905e1310940:/src/undo.c diff --git a/src/undo.c b/src/undo.c index 18bfc3a3b2..86c30c5d22 100644 --- a/src/undo.c +++ b/src/undo.c @@ -1,5 +1,5 @@ /* undo handling for GNU Emacs. - Copyright (C) 1990, 1993 Free Software Foundation, Inc. + Copyright (C) 1990, 1993, 1994 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -19,13 +19,23 @@ file named COPYING. Among other things, the copyright notice and this notice must be preserved on all copies. */ -#include "config.h" +#include #include "lisp.h" #include "buffer.h" +#include "commands.h" /* Last buffer for which undo information was recorded. */ 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; + /* 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 @@ -39,22 +49,26 @@ record_insert (beg, length) 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 (current_buffer != XBUFFER (last_undo_buffer)) Fundo_boundary (); - XSET (last_undo_buffer, Lisp_Buffer, current_buffer); + XSETBUFFER (last_undo_buffer, current_buffer); - if (MODIFF <= current_buffer->save_modified) + if (MODIFF <= SAVE_MODIFF) 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) + if (CONSP (current_buffer->undo_list)) { 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 + if (CONSP (elt) + && INTEGERP (XCONS (elt)->car) + && INTEGERP (XCONS (elt)->cdr) && XINT (XCONS (elt)->cdr) == XINT (beg)) { XSETINT (XCONS (elt)->cdr, XINT (beg) + XINT (length)); @@ -63,7 +77,7 @@ record_insert (beg, length) } lbeg = beg; - XSET (lend, Lisp_Int, XINT (beg) + XINT (length)); + XSETINT (lend, XINT (beg) + XINT (length)); current_buffer->undo_list = Fcons (Fcons (lbeg, lend), current_buffer->undo_list); } @@ -75,28 +89,39 @@ record_delete (beg, length) int beg, length; { Lisp_Object lbeg, lend, sbeg; + int at_boundary; 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 (current_buffer != XBUFFER (last_undo_buffer)) Fundo_boundary (); - XSET (last_undo_buffer, Lisp_Buffer, current_buffer); + XSETBUFFER (last_undo_buffer, current_buffer); - if (MODIFF <= current_buffer->save_modified) + at_boundary = (CONSP (current_buffer->undo_list) + && NILP (XCONS (current_buffer->undo_list)->car)); + + if (MODIFF <= SAVE_MODIFF) record_first_change (); if (point == beg + length) - XSET (sbeg, Lisp_Int, -beg); + XSETINT (sbeg, -beg); else - XFASTINT (sbeg) = beg; - XFASTINT (lbeg) = beg; - XFASTINT (lend) = beg + length; - - /* If point isn't at start of deleted range, record where it is. */ - if (PT != XFASTINT (sbeg)) + XSETFASTINT (sbeg, beg); + XSETFASTINT (lbeg, beg); + XSETFASTINT (lend, beg + length); + + /* 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) + && current_buffer == XBUFFER (last_point_position_buffer)) current_buffer->undo_list - = Fcons (make_number (PT), current_buffer->undo_list); + = Fcons (make_number (last_point_position), current_buffer->undo_list); current_buffer->undo_list = Fcons (Fcons (Fbuffer_substring (lbeg, lend), sbeg), @@ -121,8 +146,20 @@ record_change (beg, length) record_first_change () { Lisp_Object high, low; - XFASTINT (high) = (current_buffer->modtime >> 16) & 0xffff; - XFASTINT (low) = current_buffer->modtime & 0xffff; + struct buffer *base_buffer = current_buffer; + + if (EQ (current_buffer->undo_list, Qt)) + return; + + if (current_buffer != XBUFFER (last_undo_buffer)) + Fundo_boundary (); + XSETBUFFER (last_undo_buffer, current_buffer); + + if (base_buffer->base_buffer) + base_buffer = base_buffer->base_buffer; + + XSETFASTINT (high, (base_buffer->modtime >> 16) & 0xffff); + XSETFASTINT (low, base_buffer->modtime & 0xffff); current_buffer->undo_list = Fcons (Fcons (Qt, Fcons (high, low)), current_buffer->undo_list); } @@ -137,9 +174,13 @@ record_property_change (beg, length, prop, value, buffer) struct buffer *obuf = current_buffer; int boundary = 0; - if (EQ (current_buffer->undo_list, Qt)) + if (EQ (XBUFFER (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 (!EQ (buffer, last_undo_buffer)) boundary = 1; last_undo_buffer = buffer; @@ -150,11 +191,11 @@ record_property_change (beg, length, prop, value, buffer) if (boundary) Fundo_boundary (); - if (MODIFF <= current_buffer->save_modified) + if (MODIFF <= SAVE_MODIFF) record_first_change (); - XSET (lbeg, Lisp_Int, beg); - XSET (lend, Lisp_Int, beg + length); + XSETINT (lbeg, beg); + XSETINT (lend, beg + length); entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend)))); current_buffer->undo_list = Fcons (entry, current_buffer->undo_list); @@ -172,7 +213,19 @@ but another undo command will undo to the previous boundary.") return Qnil; tem = Fcar (current_buffer->undo_list); if (!NILP (tem)) - current_buffer->undo_list = Fcons (Qnil, current_buffer->undo_list); + { + /* One way or another, cons nil onto the front of the undo list. */ + if (!NILP (pending_boundary)) + { + /* If we have preallocated the cons cell to use here, + use that one. */ + XCONS (pending_boundary)->cdr = current_buffer->undo_list; + current_buffer->undo_list = pending_boundary; + pending_boundary = Qnil; + } + else + current_buffer->undo_list = Fcons (Qnil, current_buffer->undo_list); + } return Qnil; } @@ -200,8 +253,7 @@ truncate_undo_list (list, minsize, maxsize) Skip, skip, skip the undo, skip, skip, skip the undo, Skip, skip, skip the undo, skip to the undo bound'ry. (Get it? "Skip to my Loo?") */ - if (XTYPE (next) == Lisp_Cons - && NILP (XCONS (next)->car)) + if (CONSP (next) && NILP (XCONS (next)->car)) { /* Add in the space occupied by this element and its chain link. */ size_so_far += sizeof (struct Lisp_Cons); @@ -210,18 +262,17 @@ truncate_undo_list (list, minsize, maxsize) prev = next; next = XCONS (next)->cdr; } - while (XTYPE (next) == Lisp_Cons - && ! NILP (XCONS (next)->car)) + while (CONSP (next) && ! NILP (XCONS (next)->car)) { 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) + if (CONSP (elt)) { size_so_far += sizeof (struct Lisp_Cons); - if (XTYPE (XCONS (elt)->car) == Lisp_String) + if (STRINGP (XCONS (elt)->car)) size_so_far += (sizeof (struct Lisp_String) - 1 + XSTRING (XCONS (elt)->car)->size); } @@ -230,10 +281,10 @@ truncate_undo_list (list, minsize, maxsize) prev = next; next = XCONS (next)->cdr; } - if (XTYPE (next) == Lisp_Cons) + if (CONSP (next)) last_boundary = prev; - while (XTYPE (next) == Lisp_Cons) + while (CONSP (next)) { Lisp_Object elt; elt = XCONS (next)->car; @@ -253,10 +304,10 @@ truncate_undo_list (list, minsize, maxsize) /* Add in the space occupied by this element and its chain link. */ size_so_far += sizeof (struct Lisp_Cons); - if (XTYPE (elt) == Lisp_Cons) + if (CONSP (elt)) { size_so_far += sizeof (struct Lisp_Cons); - if (XTYPE (XCONS (elt)->car) == Lisp_String) + if (STRINGP (XCONS (elt)->car)) size_so_far += (sizeof (struct Lisp_String) - 1 + XSTRING (XCONS (elt)->car)->size); } @@ -283,10 +334,13 @@ truncate_undo_list (list, minsize, maxsize) 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; + (n, list) + Lisp_Object n, list; { - register int arg = XINT (count); + struct gcpro gcpro1, gcpro2; + Lisp_Object next; + int count = specpdl_ptr - specpdl; + register int arg; #if 0 /* This is a good feature, but would make undo-start unable to do what is expected. */ Lisp_Object tem; @@ -298,20 +352,28 @@ Return what remains of the list.") list = Fcdr (list); #endif + CHECK_NUMBER (n, 0); + arg = XINT (n); + 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) { - Lisp_Object next; next = Fcar (list); list = Fcdr (list); /* Exit inner loop at undo boundary. */ if (NILP (next)) break; /* Handle an integer by setting point to that value. */ - if (XTYPE (next) == Lisp_Int) + if (INTEGERP (next)) SET_PT (clip_to_bounds (BEGV, XINT (next), ZV)); - else if (XTYPE (next) == Lisp_Cons) + else if (CONSP (next)) { Lisp_Object car, cdr; @@ -322,14 +384,19 @@ Return what remains of the list.") /* Element (t high . low) records previous modtime. */ Lisp_Object high, low; int mod_time; + struct buffer *base_buffer = current_buffer; high = Fcar (cdr); low = Fcdr (cdr); mod_time = (XFASTINT (high) << 16) + XFASTINT (low); + + 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 (mod_time != current_buffer->modtime) + if (mod_time != base_buffer->modtime) break; #ifdef CLASH_DETECTION Funlock_buffer (); @@ -352,7 +419,7 @@ Return what remains of the list.") Fput_text_property (beg, end, prop, val, Qnil); } #endif /* USE_TEXT_PROPERTIES */ - else if (XTYPE (car) == Lisp_Int && XTYPE (cdr) == Lisp_Int) + else if (INTEGERP (car) && INTEGERP (cdr)) { /* Element (BEG . END) means range was inserted. */ Lisp_Object end; @@ -365,7 +432,7 @@ Return what remains of the list.") Fgoto_char (car); Fdelete_region (car, cdr); } - else if (XTYPE (car) == Lisp_String && XTYPE (cdr) == Lisp_Int) + else if (STRINGP (car) && INTEGERP (cdr)) { /* Element (STRING . POS) means STRING was deleted. */ Lisp_Object membuf; @@ -401,11 +468,18 @@ Return what remains of the list.") arg--; } - return list; + UNGCPRO; + return unbind_to (count, list); } syms_of_undo () { + Qinhibit_read_only = intern ("inhibit-read-only"); + staticpro (&Qinhibit_read_only); + + pending_boundary = Qnil; + staticpro (&pending_boundary); + defsubr (&Sprimitive_undo); defsubr (&Sundo_boundary); }