A variation on Matt Moloney's Undo/Redo "Memento" pattern
Yesterday Matt Moloney posted a nice implementation of the "Memento" pattern, which implements an undo/redo stack. Significant pieces are
- The state is held in an agent. This is not 100% needed, but makes for a nice example of using agents in this way.
- The agent is encapsulated in an object.
- The object can serve as a data context for a Xaml WPF window, reporting whether Undo/Redo is available.
- The example shows how to do some WPF scripting with F# where the Xaml code is inline. This can be a good way to learn things like data binding. You could equally read the Xaml from a file created using the designer.
I aboslutely love this sample: it demonstrates yet another example of "oh so lovely" F# design-pattern coding by using something we're all very familiar with (undo/redo) and which we know we want our applications to have.
When I looked at Matt's code, I thought of making a couple of tweaks, which I thought I'd write up here:
First, I adjusted the code to "capture the synchonization context" in the Memento object, and to do this late (when a button is pressed), rather than early. This means that, from the outside, the Memento object is just like any other GUI object - no use of background multi-threading is exposed. This means we could replace the use of an agent to hold the background state if we wished. Further, we are sure to capture the right synchronization context, i.e. the one active when a WPF button is pressed.
.Second, I adjusted the WPF fragments to use Tomas Petricek's nice idiom for looking up Xaml controls by name with a use of the F# dynamic lookup operator (?). The telltale code for this sort of thing is as follows:
let (?) (w:Control) (s:string) : 'T = (w.FindName(s) :?> 'T)
let redButton : Button = window?redButton
let greenButton : Button = window?greenButton
let blueButton : Button = window?blueButton
let undoButton : Button = window?undoButton
let redoButton : Button = window?redoButton
let grid : Grid = window?grid
- I adjusted the "Command" type to be a record - this makes the code a bit more readable
. - I removed used of List/head/List.tail in favour of pattern matching, again to make the code a bit more readable
. - Finally, I adjusted the code so that if you clicked "Red" when the form was already Red, no entry was pushed on the undo/redo stack, likewise for other colors.
.
Further below is the screen shot and code - let myself of Matt know if you think more tweaks are needed to this sample (ok, perhaps a few comments :-) ), or if you think these aren't the right tweaks to make. (Note, if using .NET 3.5, remove the references to System.Xaml).
[ Update: , if you want to remove the use of a background agent in favour of a GUI object that hold mutable state, here is the replacement code. Note this code is pretty much logically equivalent to using an agent and will be easier to debug. Methodologically it is OK and normal in F# to use mutable state to hold the state of a single-threaded GUI application ]
type Memento() =
let mutable undoStack : Command list = []
let mutable redoStack : Command list = []
let propertyChanged = Event<_,_>()
let notify this s = propertyChanged.Trigger(this, PropertyChangedEventArgs(s))
let notifyAll this =
for s in [|"CanUndo";"CanRedo";"UndoList";"RedoList"|] do
notify this s
interface INotifyPropertyChanged with
[<CLIEvent>]
member this.PropertyChanged = propertyChanged.Publish
member this.NewCommand(command:Command) =
undoStack <- command :: undoStack
notifyAll this
member this.Undo() =
match undoStack with
| [] -> ()
| cmd :: rest ->
cmd.Undo();
redoStack <- cmd :: redoStack;
undoStack <- rest
notifyAll this
member this.Redo() =
match redoStack with
| [] -> ()
| cmd :: rest ->
cmd.Redo();
undoStack <- cmd :: undoStack;
redoStack <- rest
notifyAll this
member this.Clear() = undoStack <- []; redoStack <- []
member this.CanUndo = not undoStack.IsEmpty
member this.CanRedo = not redoStack.IsEmpty
member this.UndoList = undoStack |> List.map (fun cmd -> cmd.Name)
member this.RedoList = redoStack |> List.map (fun cmd -> cmd.Name)
]
#r "PresentationCore"
#r "PresentationFramework"
#r "WindowsBase"
#r "System.Xaml"
open System
open System.Linq
open System.Windows
open System.Windows.Input
open System.Windows.Controls
open System.Windows.Data
open System.ComponentModel
open System.Windows.Shapes
open System.Windows.Media
open System.Xaml
open System.IO
open System.Text
open System.Windows.Markup
open System.Threading
type Command = { Name : string;
Undo: (unit -> unit);
Redo: (unit -> unit) }
type MementoMessage =
| UndoList of AsyncReplyChannel<seq<string>>
| RedoList of AsyncReplyChannel<seq<string>>
| UndoCommand
| RedoCommand
| Clear
| NewCommand of (Command * SynchronizationContext)
| CanUndo of AsyncReplyChannel<bool>
| CanRedo of AsyncReplyChannel<bool>
type Memento() =
let (<--) (m:'msg MailboxProcessor) x = m.Post x
let (<->) (m:_ MailboxProcessor) msg = m.PostAndReply(fun replyChannel -> msg replyChannel)
let emptyStack : (Command * SynchronizationContext) list = []
let runInGuiContext (context : SynchronizationContext) f =
context.Post(new SendOrPostCallback(fun _ -> f()),null)
let memento = new MailboxProcessor<MementoMessage>(fun inbox ->
let rec loop undoStack redoStack =
async { let! msgOption = inbox.TryReceive(timeout=0)
match msgOption with
| None ->
do! Async.Sleep(20)
return! loop undoStack redoStack
| Some(msg) ->
match msg with
| CanUndo replyChannel ->
replyChannel.Reply (undoStack |> List.isEmpty |> not)
return! loop undoStack redoStack
| CanRedo replyChannel ->
replyChannel.Reply (redoStack |> List.isEmpty |> not)
return! loop undoStack redoStack
| UndoList replyChannel ->
replyChannel.Reply (undoStack |> List.map (fun (cmd,_) -> cmd.Name))
return! loop undoStack redoStack
| RedoList replyChannel ->
replyChannel.Reply (redoStack |> List.map (fun (cmd,_) -> cmd.Name))
return! loop undoStack redoStack
| UndoCommand ->
match undoStack with
| [] -> return! loop undoStack redoStack // ignore
| (cmd,context) :: rest ->
do runInGuiContext context cmd.Undo
return! loop rest ((cmd,context)::redoStack)
| RedoCommand ->
match redoStack with
| [] -> return! loop undoStack redoStack // ignore
| (cmd,context) :: rest ->
do runInGuiContext context cmd.Redo
return! loop ((cmd,context)::undoStack) rest
| NewCommand command ->
return! loop (command::undoStack) emptyStack
| Clear ->
return! loop emptyStack emptyStack
}
loop emptyStack emptyStack
)
do
memento.Start()
let propertyChanged = Event<_,_>()
let notify this s = propertyChanged.Trigger(this, PropertyChangedEventArgs(s))
let notifyAll this =
for s in [|"CanUndo";"CanRedo";"UndoList";"RedoList"|] do
notify this s
interface INotifyPropertyChanged with
[<CLIEvent>]
member this.PropertyChanged = propertyChanged.Publish
member this.NewCommand(command:Command) =
let context = System.Threading.SynchronizationContext.Current
memento <-- NewCommand(command,context); notifyAll this
member this.Undo() = memento <-- UndoCommand; notifyAll this
member this.Redo() = memento <-- RedoCommand; notifyAll this
member this.Clear() = memento <-- Clear
member this.CanUndo = memento <-> CanUndo
member this.CanRedo = memento <-> CanRedo
member this.UndoList = memento <-> UndoList
member this.RedoList = memento <-> RedoList
let window = "<Window
xmlns=\"schemas.microsoft.com/winfx/2006/xaml/presentation\"
xmlns:x=\"schemas.microsoft.com/winfx/2006/xaml\"
Title=\"MainWindow\" Height=\"400\" Width=\"525\">
<DockPanel>
<StackPanel DockPanel.Dock=\"Left\" Width=\"150\">
<Button x:Name=\"redButton\">Red</Button>
<Button x:Name=\"greenButton\">Green</Button>
<Button x:Name=\"blueButton\">Blue</Button>
<Button IsEnabled=\"{Binding CanUndo}\" x:Name=\"undoButton\">Undo</Button>
<Button IsEnabled=\"{Binding CanRedo}\" x:Name=\"redoButton\">Redo</Button>
<Label>Undo List:</Label>
<ListBox x:Name=\"undoListBox\" MinHeight=\"100\" ItemsSource=\"{Binding UndoList}\"></ListBox>
<Label>Redo List:</Label>
<ListBox x:Name=\"redoListBox\" MinHeight=\"100\" ItemsSource=\"{Binding RedoList}\"></ListBox>
</StackPanel>
<Grid x:Name=\"grid\" Background=\"Red\" />
</DockPanel>
</Window>" |> XamlReader.Parse :?> Window
window.Show()
let memento = new Memento()
window.DataContext <- memento
let (?) (w:Control) (s:string) : 'T = w.FindName(s) :?> 'T
let redButton : Button = window?redButton
let greenButton : Button = window?greenButton
let blueButton : Button = window?blueButton
let undoButton : Button = window?undoButton
let redoButton : Button = window?redoButton
let grid : Grid = window?grid
let changeBackground(name:string, brush:Brush) =
let old = grid.Background
if old <> brush then
memento.NewCommand({ Name = name;
Undo = (fun _ -> grid.Background <- old);
Redo = (fun _ -> grid.Background <- brush) })
grid.Background <- brush
redButton.Click.Add(fun _ -> changeBackground("-> Red", Brushes.Red))
greenButton.Click.Add(fun _ -> changeBackground("-> Green", Brushes.Green))
blueButton.Click.Add(fun _ -> changeBackground("-> Blue", Brushes.Blue))
undoButton.Click.Add(fun _ -> memento.Undo())
redoButton.Click.Add(fun _ -> memento.Redo())
Enjoy!
don
Comments
- Anonymous
August 16, 2010
Hi Dom, Thanks the really great suggestions. Cheers, Matt