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=\"http://schemas.microsoft.com/winfx/2006/xaml/presentation\"

        xmlns:x=\"http://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