racket/gui: add [set-]undo-preserves-all-history[?] to editor<%>

This change allows undo configuration of individuals editors to
Emacs-style undo (in addition to the 'GRacket:emacs-undo global
preference that is read on startup).

Also, fix a bug in Emacs-style undo that dates from the port of
the editor into Racket.

pkgs/gui-pkgs/gui-doc/scribblings/gui/editor-intf.scrbl

@@ -767,6 +767,10 @@ Returns the maximum number of undoables that will be remembered by the
  multiple events at a time (such as when the user types a stream of
  characters at once).
 
+When an editor is in preserve-all-history mode (see @method[editor<%>
+ set-undo-preserves-all-history]), then any non-@racket[0] value is
+ treated the same as @racket['forever].
+
 }
 
 @defmethod[(get-max-view-size)
@@ -2282,6 +2286,10 @@ Sets the maximum number of undoables that will be remembered by the
  @indexed-racket['forever] is accepted as a synonym for a very large
  number.
 
+When an editor is in preserve-all-history mode (see @method[editor<%>
+ set-undo-preserves-all-history]), then any non-@racket[0] value is
+ treated the same as @racket['forever].
+
 }
 
 
@@ -2389,6 +2397,19 @@ Setting the style list is disallowed when the editor is internally
 
 }
 
+@defmethod[(set-undo-preserves-all-history [on? any/c]) void?]{
+
+When @racket[on?] is true, configures the editor to preserve all
+editing history, including operations that have been undone, as long
+as the maximum undo history is non-zero (see @method[editor<%>
+set-max-undo-history]).  Otherwise, operations that are undone (and not
+redone) before another operation are lost from the editor's history.
+
+The default mode is determined by the @Resource{emacs-undo} preference
+(see @secref["mredprefs"]).
+
+@history[#:added "1.1"]}
+
 
 @defmethod[(size-cache-invalid)
            void?]{
@@ -2441,6 +2462,15 @@ See also @method[editor<%> add-undo] .
 
 }
 
+
+@defmethod[(undo-preserves-all-history?) boolean?]{
+
+Reports whether the editor is in preserve-all-history mode.
+See @method[editor<%> set-undo-preserves-all-history] for more information.
+
+@history[#:added "1.1"]}
+
+
 @defmethod*[([(use-file-text-mode) boolean?]
              [(use-file-text-mode [on? any/c]) void?])]{
 

pkgs/gui-pkgs/gui-doc/scribblings/gui/prefs.scrbl

@@ -31,8 +31,10 @@ The following are the preference names used by GRacket:
  labels) are suppressed.}
 
  @item{@ResourceFirst{emacs-undo} --- a true value makes undo in
- editors work as in Emacs (i.e., undo operations are themselves kept
- in the undo stack).}
+ editors by default preserve all editing history, including operations
+ that are undone (as in Emacs); the @xmethod[editor<%>
+ set-undo-preserves-all-history] method changes a specific editor's
+ configuration.}
 
  @item{@ResourceFirst{wheelStep} --- sets the default mouse-wheel step
  size of @racket[editor-canvas%] objects.}

pkgs/gui-pkgs/gui-lib/mred/private/wxme/editor.rkt

@@ -109,7 +109,7 @@
 
 ;; ----------------------------------------
 
-(define emacs-style-undo? (and (get-preference* 'GRacket:emacs-undo) #t))
+(define default-emacs-style-undo? (and (get-preference* 'GRacket:emacs-undo) #t))
 (define (max-undo-value? v) (or (exact-nonnegative-integer? v)
                                 (eq? v 'forever)))
 
@@ -131,6 +131,7 @@
   (define redomode? #f)
   (define interceptmode? #f)
   (define loadoverwritesstyles? #t)
+  (define emacs-style-undo? default-emacs-style-undo?)
 
   (field [s-custom-cursor-overrides? #f]
          [s-need-on-display-size? #f])
@@ -870,7 +871,8 @@
               (unless (= redochanges-start redochanges-end)
                 (append-undo (vector-ref redochanges redochanges-start) #f)
                 (vector-set! redochanges redochanges-start #f)
-                (set! redochanges-start (modulo (add1 redochanges-start) redochanges-size))))
+                (set! redochanges-start (modulo (add1 redochanges-start) redochanges-size))
+                (loop)))
             (set! redochanges-start 0)
             (set! redochanges-end 0))]
          [else
@@ -1023,6 +1025,11 @@
      intercepted
      (set! interceptmode? #f)
      (set! intercepted null)))
+
+  (define/public (undo-preserves-all-history?)
+    emacs-style-undo?)
+  (define/public (set-undo-preserves-all-history on?)
+    (set! emacs-style-undo? (and on? #t)))
   
   ;; ----------------------------------------
 

pkgs/gui-pkgs/gui-lib/mred/private/wxme/undo.rkt

@@ -241,6 +241,8 @@
       (send editor resize snip x y)
       cont?)))
 
+;; Used for Emac-style undo: eventually pairs an undo action with
+;; its inverse without requiring snips to be duplicated, etc.
 (define composite-record%
   (class change-record%
     (init       count)
@@ -276,7 +278,9 @@
     (define/override (inverse)
       (make-object inverse-record% id (not parity?)))))
 
-
+;; An indirection to help with the inverse mapping in
+;; `composite-record%` an isolate it from an extra
+;; "finalization" via `cancel`:
 (define inverse-record%
   (class change-record%
     (init-field id
@@ -290,7 +294,7 @@
           (mcdr id)))
 
     (define/override (cancel)
-      ;; Avoid double-frees by not doing anything
+      ;; Avoid double-finalization by not doing anything
       (void))
 
     (define/override (undo editor)

pkgs/gui-pkgs/gui-test/tests/gracket/undo.rkt

@@ -0,0 +1,58 @@
+#lang racket/gui
+
+;; Tests for Emacs-style undo in a `text%`
+
+(define (mk)
+  (define t (new text%))
+  (send t set-max-undo-history 1)
+  (send t set-undo-preserves-all-history #t)
+  t)
+
+(define (deep t)
+  (define (touch)
+    (send t begin-edit-sequence #f)
+    (send t change-style (make-object style-delta% 'change-bold) 0 (send t last-position))
+    (send t end-edit-sequence))
+
+  (define (try n)
+    (unless (= n 1000)
+      (send t insert "hello\n")
+      (send t undo)
+      (send t begin-edit-sequence)
+      (send t insert "mo")
+      (send t insert "re")
+      (send t end-edit-sequence)
+      (touch)
+      (send t undo)
+      (send t undo) ; hello is back
+      (send t undo)
+      (try (add1 n))))
+
+  (try 0)
+  (unless (equal? "" (send t get-text))
+    (error "failed"))
+  t)
+
+(define (bounce t)
+  (define (undo s)
+    (send t undo)
+    (define got (send t get-text))
+    (unless (equal? s got)
+      (error 'undo "fail: ~s vs. ~s" s got)))
+
+  (send t insert "hello")
+  (undo "")
+  (send t insert "goodbye")
+  (undo "")
+  (undo "hello")
+  (undo "")
+  (send t insert "more")
+  (undo "")
+  (undo "hello")
+  (undo "")
+  (undo "goodbye")
+  (undo ""))
+
+(void (deep (mk)))
+(bounce (mk))
+(bounce (deep (mk)))