* lisp/simple.el (primitive-undo): Move from undo.c.
* src/undo.c (Fprimitive_undo): Move to simple.el. (syms_of_undo): Remove declaration for Sprimitive_undo. * test/automated/undo-tests.el: New file.
This commit is contained in:
Aaron S. Hawley
Stefan Monnier
parent
1c851e98b6
commit
3bace969f3
6 changed files with 379 additions and 212 deletions
|
|
@ -1,3 +1,7 @@
|
|||
2013-01-08 Aaron S. Hawley <aaron.s.hawley@gmail.com>
|
||||
|
||||
* simple.el (primitive-undo): Move from undo.c.
|
||||
|
||||
2013-01-08 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* vc/pcvs.el (cvs-cleanup-collection): Extend meaning of `rm-handled'.
|
||||
|
|
|
|||
135
lisp/simple.el
135
lisp/simple.el
|
|
@ -1979,6 +1979,141 @@ then call `undo-more' one or more times to undo them."
|
|||
(if (null pending-undo-list)
|
||||
(setq pending-undo-list t))))
|
||||
|
||||
(defun primitive-undo (n list)
|
||||
"Undo N records from the front of the list LIST.
|
||||
Return what remains of the list."
|
||||
|
||||
;; This is a good feature, but would make undo-start
|
||||
;; unable to do what is expected.
|
||||
;;(when (null (car (list)))
|
||||
;; ;; 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.
|
||||
;; (setq list (cdr list))))
|
||||
|
||||
(let ((arg n)
|
||||
;; In a writable buffer, enable undoing read-only text that is
|
||||
;; so because of text properties.
|
||||
(inhibit-read-only t)
|
||||
;; Don't let `intangible' properties interfere with undo.
|
||||
(inhibit-point-motion-hooks t)
|
||||
;; We use oldlist only to check for EQ. ++kfs
|
||||
(oldlist buffer-undo-list)
|
||||
(did-apply nil)
|
||||
(next nil))
|
||||
(while (> arg 0)
|
||||
(while (and (consp list)
|
||||
(progn
|
||||
(setq next (car list))
|
||||
(setq list (cdr list))
|
||||
;; Exit inner loop at undo boundary.
|
||||
(not (null next))))
|
||||
;; Handle an integer by setting point to that value.
|
||||
(cond
|
||||
((integerp next) (goto-char next))
|
||||
((consp next)
|
||||
(let ((car (car next))
|
||||
(cdr (cdr next)))
|
||||
(cond
|
||||
;; Element (t . TIME) records previous modtime.
|
||||
;; Preserve any flag of NONEXISTENT_MODTIME_NSECS or
|
||||
;; UNKNOWN_MODTIME_NSECS.
|
||||
((eq t car)
|
||||
;; If this records an obsolete save
|
||||
;; (not matching the actual disk file)
|
||||
;; then don't mark unmodified.
|
||||
(when (or (equal cdr (visited-file-modtime))
|
||||
(and (consp cdr)
|
||||
(equal (list (car cdr) (cdr cdr))
|
||||
(visited-file-modtime))))
|
||||
(when (fboundp 'unlock-buffer)
|
||||
(unlock-buffer))
|
||||
(set-buffer-modified-p nil)))
|
||||
;; Element (nil PROP VAL BEG . END) is property change.
|
||||
((eq nil car)
|
||||
(let ((beg (nth 2 cdr))
|
||||
(end (nthcdr 3 cdr))
|
||||
(prop (car cdr))
|
||||
(val (cadr cdr)))
|
||||
(when (or (> (point-min) beg)
|
||||
(< (point-max) end))
|
||||
(error "Changes to be undone are outside visible portion of buffer"))
|
||||
(put-text-property beg end prop val)))
|
||||
((and (integerp car) (integerp cdr))
|
||||
;; Element (BEG . END) means range was inserted.
|
||||
(when (or (< car (point-min))
|
||||
(> cdr (point-max)))
|
||||
(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.
|
||||
(goto-char car)
|
||||
(delete-region car cdr))
|
||||
((eq car 'apply)
|
||||
;; Element (apply FUN . ARGS) means call FUN to undo.
|
||||
(let ((currbuff (current-buffer))
|
||||
(car (car cdr))
|
||||
(cdr (cdr cdr)))
|
||||
(if (integerp car)
|
||||
;; Long format: (apply DELTA START END FUN . ARGS).
|
||||
(let* ((delta car)
|
||||
(start (car cdr))
|
||||
(end (cadr cdr))
|
||||
(start-mark (copy-marker start nil))
|
||||
(end-mark (copy-marker end t))
|
||||
(cdr (cddr cdr))
|
||||
(fun (car cdr))
|
||||
(args (cdr cdr)))
|
||||
(apply fun args) ;; Use `save-current-buffer'?
|
||||
;; Check that the function did what the entry
|
||||
;; said it would do.
|
||||
(unless (and (eq start
|
||||
(marker-position start-mark))
|
||||
(eq (+ delta end)
|
||||
(marker-position end-mark)))
|
||||
(error "Changes to be undone by function different than announced"))
|
||||
(set-marker start-mark nil)
|
||||
(set-marker end-mark nil))
|
||||
(apply car cdr))
|
||||
(unless (eq currbuff (current-buffer))
|
||||
(error "Undo function switched buffer"))
|
||||
(setq did-apply t)))
|
||||
((and (stringp car) (integerp cdr))
|
||||
;; Element (STRING . POS) means STRING was deleted.
|
||||
(let ((membuf car)
|
||||
(pos cdr))
|
||||
(when (or (< (abs pos) (point-min))
|
||||
(> (abs pos) (point-max)))
|
||||
(error "Changes to be undone are outside visible portion of buffer"))
|
||||
(if (< pos 0)
|
||||
(progn
|
||||
(goto-char (- pos))
|
||||
(insert membuf))
|
||||
(goto-char 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.
|
||||
(insert membuf)
|
||||
(goto-char pos))))
|
||||
((and (markerp car) (integerp cdr))
|
||||
;; (MARKER . INTEGER) means a marker MARKER
|
||||
;; was adjusted by INTEGER.
|
||||
(when (marker-buffer car)
|
||||
(set-marker car
|
||||
(- (marker-position car) cdr)
|
||||
(marker-buffer car))))
|
||||
(t (error "Unrecognized entry in undo list %S" next)))))
|
||||
(t (error "Unrecognized entry in undo list %S" next))))
|
||||
(setq arg (1- 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 (and did-apply
|
||||
(eq oldlist buffer-undo-list))
|
||||
(setq buffer-undo-list
|
||||
(cons (list 'apply 'cdr nil) buffer-undo-list))))
|
||||
list)
|
||||
|
||||
;; Deep copy of a list
|
||||
(defun undo-copy-list (list)
|
||||
"Make a copy of undo list LIST."
|
||||
|
|
|
|||
|
|
@ -1,3 +1,8 @@
|
|||
2013-01-08 Aaron S. Hawley <aaron.s.hawley@gmail.com>
|
||||
|
||||
* undo.c (Fprimitive_undo): Move to simple.el.
|
||||
(syms_of_undo): Remove declarations for Sprimitive_undo.
|
||||
|
||||
2013-01-08 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* keyboard.c (echo_add_key): Rename from echo_add_char.
|
||||
|
|
|
|||
212
src/undo.c
212
src/undo.c
|
|
@ -451,217 +451,6 @@ 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)
|
||||
|
|
@ -675,7 +464,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,
|
||||
|
|
|
|||
|
|
@ -1,3 +1,7 @@
|
|||
2013-01-08 Aaron S. Hawley <aaron.s.hawley@gmail.com>
|
||||
|
||||
* automated/undo-tests.el: New file.
|
||||
|
||||
2012-12-27 Dmitry Gutov <dgutov@yandex.ru>
|
||||
|
||||
* automated/ruby-mode-tests.el
|
||||
|
|
|
|||
231
test/automated/undo-tests.el
Normal file
231
test/automated/undo-tests.el
Normal file
|
|
@ -0,0 +1,231 @@
|
|||
;;; undo-tests.el --- Tests of primitive-undo
|
||||
|
||||
;; Copyright (C) 2012 Aaron S. Hawley
|
||||
|
||||
;; Author: Aaron S. Hawley <aaron.s.hawley@gmail.com>
|
||||
|
||||
;; This program 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 3 of the
|
||||
;; License, or (at your option) any later version.
|
||||
;;
|
||||
;; This program 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 this program. If not, see `http://www.gnu.org/licenses/'.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Profiling when the code was translate from C to Lisp on 2012-12-24.
|
||||
|
||||
;;; C
|
||||
|
||||
;; (elp-instrument-function 'primitive-undo)
|
||||
;; (load-file "undo-test.elc")
|
||||
;; (benchmark 100 '(let ((undo-test5-error nil)) (undo-test-all)))
|
||||
;; Elapsed time: 305.218000s (104.841000s in 14804 GCs)
|
||||
;; M-x elp-results
|
||||
;; Function Name Call Count Elapsed Time Average Time
|
||||
;; primitive-undo 2600 3.4889999999 0.0013419230
|
||||
|
||||
;;; Lisp
|
||||
|
||||
;; (load-file "primundo.elc")
|
||||
;; (elp-instrument-function 'primitive-undo)
|
||||
;; (benchmark 100 '(undo-test-all))
|
||||
;; Elapsed time: 295.974000s (104.582000s in 14704 GCs)
|
||||
;; M-x elp-results
|
||||
;; Function Name Call Count Elapsed Time Average Time
|
||||
;; primitive-undo 2700 3.6869999999 0.0013655555
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ert)
|
||||
|
||||
(ert-deftest undo-test0 ()
|
||||
"Test basics of \\[undo]."
|
||||
(with-temp-buffer
|
||||
(buffer-enable-undo)
|
||||
(condition-case err
|
||||
(undo)
|
||||
(error
|
||||
(unless (string= "No further undo information"
|
||||
(cadr err))
|
||||
(error err))))
|
||||
(undo-boundary)
|
||||
(insert "This")
|
||||
(undo-boundary)
|
||||
(erase-buffer)
|
||||
(undo-boundary)
|
||||
(insert "That")
|
||||
(undo-boundary)
|
||||
(forward-word -1)
|
||||
(undo-boundary)
|
||||
(insert "With ")
|
||||
(undo-boundary)
|
||||
(forward-word -1)
|
||||
(undo-boundary)
|
||||
(kill-word 1)
|
||||
(undo-boundary)
|
||||
(put-text-property (point-min) (point-max) 'face 'bold)
|
||||
(undo-boundary)
|
||||
(remove-text-properties (point-min) (point-max) '(face default))
|
||||
(undo-boundary)
|
||||
(set-buffer-multibyte (not enable-multibyte-characters))
|
||||
(undo-boundary)
|
||||
(undo)
|
||||
(should
|
||||
(equal (should-error (undo-more nil))
|
||||
'(wrong-type-argument integerp nil)))
|
||||
(undo-more 7)
|
||||
(should (string-equal "" (buffer-string)))))
|
||||
|
||||
(ert-deftest undo-test1 ()
|
||||
"Test undo of \\[undo] command (redo)."
|
||||
(with-temp-buffer
|
||||
(buffer-enable-undo)
|
||||
(undo-boundary)
|
||||
(insert "This")
|
||||
(undo-boundary)
|
||||
(erase-buffer)
|
||||
(undo-boundary)
|
||||
(insert "That")
|
||||
(undo-boundary)
|
||||
(forward-word -1)
|
||||
(undo-boundary)
|
||||
(insert "With ")
|
||||
(undo-boundary)
|
||||
(forward-word -1)
|
||||
(undo-boundary)
|
||||
(kill-word 1)
|
||||
(undo-boundary)
|
||||
(facemenu-add-face 'bold (point-min) (point-max))
|
||||
(undo-boundary)
|
||||
(set-buffer-multibyte (not enable-multibyte-characters))
|
||||
(undo-boundary)
|
||||
(should
|
||||
(string-equal (buffer-string)
|
||||
(progn
|
||||
(undo)
|
||||
(undo-more 4)
|
||||
(undo)
|
||||
;(undo-more -4)
|
||||
(buffer-string))))))
|
||||
|
||||
(ert-deftest undo-test2 ()
|
||||
"Test basic redoing with \\[undo] command."
|
||||
(with-temp-buffer
|
||||
(buffer-enable-undo)
|
||||
(undo-boundary)
|
||||
(insert "One")
|
||||
(undo-boundary)
|
||||
(insert " Zero")
|
||||
(undo-boundary)
|
||||
(push-mark)
|
||||
(delete-region (save-excursion
|
||||
(forward-word -1)
|
||||
(point)) (point))
|
||||
(undo-boundary)
|
||||
(beginning-of-line)
|
||||
(insert "Zero")
|
||||
(undo-boundary)
|
||||
(undo)
|
||||
(should
|
||||
(string-equal (buffer-string)
|
||||
(progn
|
||||
(undo-more 2)
|
||||
(undo)
|
||||
(buffer-string))))))
|
||||
|
||||
(ert-deftest undo-test3 ()
|
||||
"Test modtime with \\[undo] command."
|
||||
(let ((tmpfile (make-temp-file "undo-test3")))
|
||||
(with-temp-file tmpfile
|
||||
(let ((buffer-file-name tmpfile))
|
||||
(buffer-enable-undo)
|
||||
(set (make-local-variable 'make-backup-files) nil)
|
||||
(undo-boundary)
|
||||
(insert ?\s)
|
||||
(undo-boundary)
|
||||
(basic-save-buffer)
|
||||
(insert ?\t)
|
||||
(undo)
|
||||
(should
|
||||
(string-equal (buffer-string)
|
||||
(progn
|
||||
(undo)
|
||||
(buffer-string)))))
|
||||
(delete-file tmpfile))))
|
||||
|
||||
(ert-deftest undo-test4 ()
|
||||
"Test \\[undo] of \\[flush-lines]."
|
||||
(with-temp-buffer
|
||||
(buffer-enable-undo)
|
||||
(dotimes (i 1048576)
|
||||
(if (zerop (% i 2))
|
||||
(insert "Evenses")
|
||||
(insert "Oddses")))
|
||||
(undo-boundary)
|
||||
(should
|
||||
;; Avoid string-equal because ERT will save the `buffer-string'
|
||||
;; to the explanation. Using `not' will record nil or non-nil.
|
||||
(not
|
||||
(null
|
||||
(string-equal (buffer-string)
|
||||
(progn
|
||||
(flush-lines "oddses" (point-min) (point-max))
|
||||
(undo-boundary)
|
||||
(undo)
|
||||
(undo)
|
||||
(buffer-string))))))))
|
||||
|
||||
(ert-deftest undo-test5 ()
|
||||
"Test basic redoing with \\[undo] command."
|
||||
(with-temp-buffer
|
||||
(buffer-enable-undo)
|
||||
(undo-boundary)
|
||||
(insert "AYE")
|
||||
(undo-boundary)
|
||||
(insert " BEE")
|
||||
(undo-boundary)
|
||||
(setq buffer-undo-list (cons '(0.0 bogus) buffer-undo-list))
|
||||
(push-mark)
|
||||
(delete-region (save-excursion
|
||||
(forward-word -1)
|
||||
(point)) (point))
|
||||
(undo-boundary)
|
||||
(beginning-of-line)
|
||||
(insert "CEE")
|
||||
(undo-boundary)
|
||||
(undo)
|
||||
(setq buffer-undo-list (cons "bogus" buffer-undo-list))
|
||||
(should
|
||||
(string-equal
|
||||
(buffer-string)
|
||||
(progn
|
||||
(if (and (boundp 'undo-test5-error) (not undo-test5-error))
|
||||
(progn
|
||||
(should (null (undo-more 2)))
|
||||
(should (undo)))
|
||||
;; Errors are generated by new Lisp version of
|
||||
;; `primitive-undo' not by built-in C version.
|
||||
(should
|
||||
(equal (should-error (undo-more 2))
|
||||
'(error "Unrecognized entry in undo list (0.0 bogus)")))
|
||||
(should
|
||||
(equal (should-error (undo))
|
||||
'(error "Unrecognized entry in undo list \"bogus\""))))
|
||||
(buffer-string))))))
|
||||
|
||||
(defun undo-test-all (&optional interactive)
|
||||
"Run all tests for \\[undo]."
|
||||
(interactive "p")
|
||||
(if interactive
|
||||
(ert-run-tests-interactively "^undo-")
|
||||
(ert-run-tests-batch "^undo-")))
|
||||
|
||||
(provide 'undo-tests)
|
||||
;;; undo-tests.el ends here
|
||||
Loading…
Add table
Reference in a new issue