X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/265a9e559da4ac72d154ecd638c51801b3e97847..97f3b3d6e9f5524a01443f9352737013be4fc6ae:/src/undo.c diff --git a/src/undo.c b/src/undo.c index 852771764f..2e6cae310b 100644 --- a/src/undo.c +++ b/src/undo.c @@ -1,5 +1,5 @@ /* undo handling for GNU Emacs. - Copyright (C) 1990 Free Software Foundation, Inc. + Copyright (C) 1990, 1993 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -26,6 +26,8 @@ and this notice must be preserved on all copies. */ /* Last buffer for which undo information was recorded. */ Lisp_Object last_undo_buffer; +Lisp_Object Qinhibit_read_only; + /* 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 @@ -36,12 +38,13 @@ record_insert (beg, length) { Lisp_Object lbeg, lend; + if (EQ (current_buffer->undo_list, Qt)) + return; + 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 (); @@ -54,16 +57,17 @@ record_insert (beg, length) if (XTYPE (elt) == Lisp_Cons && XTYPE (XCONS (elt)->car) == Lisp_Int && XTYPE (XCONS (elt)->cdr) == Lisp_Int - && XINT (XCONS (elt)->cdr) == beg) + && XINT (XCONS (elt)->cdr) == XINT (beg)) { - XSETINT (XCONS (elt)->cdr, beg + length); + XSETINT (XCONS (elt)->cdr, XINT (beg) + XINT (length)); return; } } - XFASTINT (lbeg) = beg; - XFASTINT (lend) = beg + length; - current_buffer->undo_list = Fcons (Fcons (lbeg, lend), current_buffer->undo_list); + lbeg = beg; + XSET (lend, Lisp_Int, XINT (beg) + XINT (length)); + current_buffer->undo_list = Fcons (Fcons (lbeg, lend), + current_buffer->undo_list); } /* Record that a deletion is about to take place, @@ -74,12 +78,13 @@ record_delete (beg, length) { Lisp_Object lbeg, lend, sbeg; + if (EQ (current_buffer->undo_list, Qt)) + return; + 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 (); @@ -89,6 +94,12 @@ record_delete (beg, length) 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)) + current_buffer->undo_list + = Fcons (make_number (PT), current_buffer->undo_list); + current_buffer->undo_list = Fcons (Fcons (Fbuffer_substring (lbeg, lend), sbeg), current_buffer->undo_list); @@ -117,6 +128,41 @@ record_first_change () current_buffer->undo_list = Fcons (Fcons (Qt, Fcons (high, low)), current_buffer->undo_list); } +/* Record a change in property PROP (whose old value was VAL) + for LENGTH characters starting at position BEG in BUFFER. */ + +record_property_change (beg, length, prop, value, buffer) + int beg, length; + Lisp_Object prop, value, buffer; +{ + Lisp_Object lbeg, lend, entry; + struct buffer *obuf = current_buffer; + int boundary = 0; + + if (EQ (current_buffer->undo_list, Qt)) + return; + + if (!EQ (buffer, last_undo_buffer)) + boundary = 1; + last_undo_buffer = buffer; + + /* Switch temporarily to the buffer that was changed. */ + current_buffer = XBUFFER (buffer); + + if (boundary) + Fundo_boundary (); + + if (MODIFF <= current_buffer->save_modified) + record_first_change (); + + XSET (lbeg, Lisp_Int, beg); + XSET (lend, Lisp_Int, beg + length); + entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend)))); + current_buffer->undo_list = Fcons (entry, current_buffer->undo_list); + + current_buffer = obuf; +} + 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\ @@ -135,8 +181,8 @@ 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. 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. */ + In practice, these are the values of undo-limit and + undo-strong-limit. */ Lisp_Object truncate_undo_list (list, minsize, maxsize) @@ -154,9 +200,10 @@ truncate_undo_list (list, minsize, maxsize) 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 (XTYPE (next) == Lisp_Cons - && XCONS (next)->car == Qnil) + && NILP (XCONS (next)->car)) { /* Add in the space occupied by this element and its chain link. */ size_so_far += sizeof (struct Lisp_Cons); @@ -166,7 +213,7 @@ truncate_undo_list (list, minsize, maxsize) next = XCONS (next)->cdr; } while (XTYPE (next) == Lisp_Cons - && XCONS (next)->car != Qnil) + && ! NILP (XCONS (next)->car)) { Lisp_Object elt; elt = XCONS (next)->car; @@ -238,10 +285,11 @@ 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); + int count = specpdl_ptr - specpdl; + register int arg = XINT (n); #if 0 /* This is a good feature, but would make undo-start unable to do what is expected. */ Lisp_Object tem; @@ -253,73 +301,121 @@ Return what remains of the list.") list = Fcdr (list); #endif + /* 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, car, cdr; + Lisp_Object next; next = Fcar (list); list = Fcdr (list); + /* Exit inner loop at undo boundary. */ if (NILP (next)) break; - car = Fcar (next); - cdr = Fcdr (next); - if (EQ (car, Qt)) + /* Handle an integer by setting point to that value. */ + if (XTYPE (next) == Lisp_Int) + SET_PT (clip_to_bounds (BEGV, XINT (next), ZV)); + else if (XTYPE (next) == Lisp_Cons) { - 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; + Lisp_Object car, cdr; + + car = Fcar (next); + cdr = Fcdr (next); + if (EQ (car, Qt)) + { + /* Element (t high . low) records previous modtime. */ + Lisp_Object high, low; + int mod_time; + + high = Fcar (cdr); + low = Fcdr (cdr); + mod_time = (XFASTINT (high) << 16) + XFASTINT (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 (); + 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) + Fset_buffer_modified_p (Qnil); + } +#ifdef USE_TEXT_PROPERTIES + else if (EQ (car, Qnil)) { - if (-pos < BEGV || -pos > ZV) - error ("Changes to be undone are outside visible portion of buffer"); - SET_PT (-pos); - Finsert (1, &membuf); + /* 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); } - else +#endif /* USE_TEXT_PROPERTIES */ + else if (XTYPE (car) == Lisp_Int && XTYPE (cdr) == Lisp_Int) { - if (pos < BEGV || pos > ZV) + /* Element (BEG . END) means range was inserted. */ + Lisp_Object end; + + if (XINT (car) < BEGV + || XINT (cdr) > ZV) error ("Changes to be undone are outside visible portion of buffer"); - SET_PT (pos); - Finsert (1, &membuf); - SET_PT (pos); + /* 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 (XTYPE (car) == Lisp_String && XTYPE (cdr) == Lisp_Int) + { + /* Element (STRING . POS) means STRING was deleted. */ + 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); + + /* 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. */ + Finsert_before_markers (1, &membuf); + SET_PT (pos); + } } } } arg--; } - return list; + return unbind_to (count, list); } syms_of_undo () { + Qinhibit_read_only = intern ("inhibit-read-only"); + staticpro (&Qinhibit_read_only); + defsubr (&Sprimitive_undo); defsubr (&Sundo_boundary); }