diff --git a/pkgs/gui-pkgs/gui-doc/scribblings/gui/editor-intf.scrbl b/pkgs/gui-pkgs/gui-doc/scribblings/gui/editor-intf.scrbl index f85728676a..68c8a5b728 100644 --- a/pkgs/gui-pkgs/gui-doc/scribblings/gui/editor-intf.scrbl +++ b/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?])]{ diff --git a/pkgs/gui-pkgs/gui-doc/scribblings/gui/prefs.scrbl b/pkgs/gui-pkgs/gui-doc/scribblings/gui/prefs.scrbl index 689689ae58..6b7ecbdd02 100644 --- a/pkgs/gui-pkgs/gui-doc/scribblings/gui/prefs.scrbl +++ b/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.} diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wxme/editor.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wxme/editor.rkt index 5d1ecb1876..c485b5a629 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wxme/editor.rkt +++ b/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))) ;; ---------------------------------------- diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wxme/undo.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wxme/undo.rkt index cddc0cc2bf..130d2ba3e3 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wxme/undo.rkt +++ b/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) diff --git a/pkgs/gui-pkgs/gui-test/tests/gracket/undo.rkt b/pkgs/gui-pkgs/gui-test/tests/gracket/undo.rkt new file mode 100644 index 0000000000..e14be23fc8 --- /dev/null +++ b/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)))