X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/eada086196ccb005ded188ac2e58d41f3682a125..db50ad5f11cc5809c27091181a13ee7aa34ec5ed:/src/undo.c
diff --git a/src/undo.c b/src/undo.c
index 9cd1d5f9f6..88cca102b6 100644
--- a/src/undo.c
+++ b/src/undo.c
@@ -1,5 +1,6 @@
/* undo handling for GNU Emacs.
- Copyright (C) 1990, 1993-1994, 2000-2012 Free Software Foundation, Inc.
+ Copyright (C) 1990, 1993-1994, 2000-2013 Free Software Foundation,
+ Inc.
This file is part of GNU Emacs.
@@ -18,7 +19,7 @@ along with GNU Emacs. If not, see . */
#include
-#include
+
#include "lisp.h"
#include "character.h"
#include "buffer.h"
@@ -54,7 +55,7 @@ static Lisp_Object pending_boundary;
static void
record_point (ptrdiff_t pt)
{
- int at_boundary;
+ bool at_boundary;
/* Don't record position of pt when undo_inhibit_record_point holds. */
if (undo_inhibit_record_point)
@@ -76,7 +77,7 @@ record_point (ptrdiff_t pt)
if (CONSP (BVAR (current_buffer, undo_list)))
{
- /* Set AT_BOUNDARY to 1 only when we have nothing other than
+ /* Set AT_BOUNDARY only when we have nothing other than
marker adjustment before undo boundary. */
Lisp_Object tail = BVAR (current_buffer, undo_list), elt;
@@ -228,10 +229,9 @@ record_first_change (void)
if (base_buffer->base_buffer)
base_buffer = base_buffer->base_buffer;
- bset_undo_list
- (current_buffer,
- Fcons (Fcons (Qt, make_lisp_time (base_buffer->modtime)),
- BVAR (current_buffer, undo_list)));
+ bset_undo_list (current_buffer,
+ Fcons (Fcons (Qt, Fvisited_file_modtime ()),
+ BVAR (current_buffer, undo_list)));
}
/* Record a change in property PROP (whose old value was VAL)
@@ -244,7 +244,7 @@ record_property_change (ptrdiff_t beg, ptrdiff_t length,
{
Lisp_Object lbeg, lend, entry;
struct buffer *obuf = current_buffer, *buf = XBUFFER (buffer);
- int boundary = 0;
+ bool boundary = 0;
if (EQ (BVAR (buf, undo_list), Qt))
return;
@@ -444,223 +444,6 @@ truncate_undo_list (struct buffer *b)
unbind_to (count, Qnil);
}
-static _Noreturn void
-user_error (const char *msg)
-{
- xsignal1 (Quser_error, build_string (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)
@@ -674,7 +457,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,