unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* bug#13271: primitive-undo in Lisp
@ 2012-12-24 18:44 Aaron S. Hawley
  2013-01-08 19:14 ` Stefan Monnier
  0 siblings, 1 reply; 2+ messages in thread
From: Aaron S. Hawley @ 2012-12-24 18:44 UTC (permalink / raw)
  To: 13271

[-- Attachment #1: Type: text/plain, Size: 2357 bytes --]

At Stefan's request, I'm submitting a patch to convert
`primitive-undo' from C to Lisp.  I had originally submitted a version
of this code to gnu-emacs-sources.

http://lists.gnu.org/archive/html/gnu-emacs-sources/2012-11/msg00026.html

This function is the engine behind the `undo' command in Emacs -- C-/,
C-x u and so on.  I've purposely cargo-culted the original C version,
including carrying over the comments and the parts that I believe are
vestigial.  I've been using and maintaining this code since 2010 and
haven't had any issues.

In the while-loop over buffer-undo-list, Stefan suggested adding a new
error condition for unrecognized entries.  I've added such an error.
Using this code daily I have not reached the error condition.  Only
with the unit tests that purposely fubar the contents of
buffer-undo-list is the error reached.

This patch is against trunk.  I did not compile and test the C
changes.  And I've only tested the it in a pretest release for 24.2,
not what is in trunk.  I'm confident it should work given there are no
differences in undo.c.  To make up for these sins, I'm submitting unit
tests.

I wrote 6 tests that cover most of the execution paths and behavior.
These tests call `primitive-undo' 27 times.  I've benchmarked the Lisp
and C versions using benchmark.el end `elp-instrument-function' by
running the tests 100 times.  The elapsed time of these tests on my
computer for both versions of `primitive-undo' is approximately 300
seconds.

(benchmark 100 '(let ((undo-test5-error nil)) (undo-test-all)))
=> Elapsed time: 305.218000s (104.841000s in 14804 GCs)
(benchmark 100 '(undo-test-all)) ;; Lisp `primitive-undo'
=> Elapsed time: 295.974000s (104.582000s in 14704 GCs)

Out of those 3 minutes, less than 4 seconds is attributable to
`primitive-undo'.  They average 1/700th (0.0014) of a second per call
of `primitive-undo' for both versions.

Function Name        Call Count  Elapsed Time  Average Time
=============        ==========  ============  ============
primitive-undo C     2600        3.4889999999  0.0013419230
primitive-undo Lisp  2700        3.6869999999  0.0013655555

I've added these results to the unit tests source file for posterity.
aaron

-- 
In general, we reserve the right to have a poor
memory--the computer, however, is supposed to
remember!  Poor computer.  -- Guy Lewis Steele Jr.

[-- Attachment #2: primundo.diff --]
[-- Type: application/octet-stream, Size: 21784 bytes --]

--- lisp/ChangeLog	2012-12-24 12:14:04 +0000
+++ lisp/ChangeLog	2012-12-24 18:12:24 +0000
@@ -1,3 +1,8 @@
+2012-12-24  Aaron S. Hawley  <aaron.s.hawley@gmail.com>
+
+	* simple.el (primitive-undo): Translate Fprimitive_undo in undo.c
+	to Lisp.
+
 2012-12-24  Lars Ingebrigtsen  <larsi@gnus.org>
 
 	* mail/smtpmail.el (smtpmail-try-auth-method): Refactored out into

--- lisp/simple.el	2012-12-21 08:10:26 +0000
+++ lisp/simple.el	2012-12-24 17:54:20 +0000
@@ -1979,6 +1979,144 @@
     (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 (not 'ever)
+    ;; 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.
+    (when (null (car (list)))
+      (setq list (cdr list))))
+
+  (when (not (numberp n))
+    (signal 'wrong-type-argument (list 'integerp n)))
+  (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."

--- src/ChangeLog	2012-12-24 12:21:42 +0000
+++ src/ChangeLog	2012-12-24 18:12:11 +0000
@@ -1,3 +1,10 @@
+2012-12-24  Aaron S. Hawley  <aaron.s.hawley@gmail.com>
+
+	* undo.c (Fprimitive_undo): Remove and translated to Lisp as
+	primitive-undo.
+	(syms_of_undo): Remove declaratations for Sprimitive_undo,
+	Qinhibit_read_only, and Qapply.
+
 2012-12-24  Dmitry Antipov  <dmantipov@yandex.ru>
 
 	* buffer.h (BUF_COMPACT): New macro to follow the common style.

--- src/undo.c	2012-09-15 07:06:56 +0000
+++ src/undo.c	2012-12-24 17:52:41 +0000
@@ -451,230 +451,15 @@
 }
 
 \f
-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);
-}
-\f
 void
 syms_of_undo (void)
 {
-  DEFSYM (Qinhibit_read_only, "inhibit-read-only");
-  DEFSYM (Qapply, "apply");
-
   pending_boundary = Qnil;
   staticpro (&pending_boundary);
 
   last_undo_buffer = NULL;
   last_boundary_buffer = NULL;
 
-  defsubr (&Sprimitive_undo);
   defsubr (&Sundo_boundary);
 
   DEFVAR_INT ("undo-limit", undo_limit,

--- test/ChangeLog	2012-12-14 06:58:15 +0000
+++ test/ChangeLog	2012-12-24 18:12:03 +0000
@@ -1,3 +1,7 @@
+2012-12-24  Aaron S. Hawley  <aaron.s.hawley@gmail.com>
+
+	* automated/undo-tests.el: New file.
+
 2012-12-14  Dmitry Gutov  <dgutov@yandex.ru>
 
 	* automated/ruby-mode-tests.el

--- test/automated/undo-tests.el	1970-01-01 00:00:00 +0000
+++ test/automated/undo-tests.el	2012-12-24 18:00:01 +0000
@@ -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


^ permalink raw reply	[flat|nested] 2+ messages in thread

* bug#13271: primitive-undo in Lisp
  2012-12-24 18:44 bug#13271: primitive-undo in Lisp Aaron S. Hawley
@ 2013-01-08 19:14 ` Stefan Monnier
  0 siblings, 0 replies; 2+ messages in thread
From: Stefan Monnier @ 2013-01-08 19:14 UTC (permalink / raw)
  To: Aaron S. Hawley; +Cc: 13271-done

> At Stefan's request, I'm submitting a patch to convert
> `primitive-undo' from C to Lisp.  I had originally submitted a version
> of this code to gnu-emacs-sources.

Thank you, installed,


        Stefan





^ permalink raw reply	[flat|nested] 2+ messages in thread

end of thread, other threads:[~2013-01-08 19:14 UTC | newest]

Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2012-12-24 18:44 bug#13271: primitive-undo in Lisp Aaron S. Hawley
2013-01-08 19:14 ` Stefan Monnier

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).