Canvas undo and redo

Summary

Richard Suchenwirth 2005-12-26: Tk's [[text] widget has undo/redo functionality, so one might ask how to have that for [[canvas] widgets as well. As someone asked for it, here's an experimental script with just a canvas, on which you can doodle with left mouse-button down, and Undo and Redo buttons.

  • When a canvas item is created, its ID is pushed on the Undo stack
  • On Undo, the last item's description is pushed on Redo, and deleted
  • On Redo, the last deleted item is recreated, and pushed on Undo again

Description

Seems to work nice and robustly in my tests. However, in my simple ways I usually prefer to just code

bind $canvas <3> [list $canvas delete current]

so I'm not tied to the creation order. Then again, this approach has no Redo.. :)

#-- Doodling: start a line, and continue it on Motion
proc newLine {w x y} {
    push ::Undo [set ::ID [$w create line $x $y $x $y]]
}
proc drawLine {w x y} {
    $w coords $::ID [concat [$w coords $::ID] $x $y]
}
#-- What this page is all about :-) 
proc undo w {
    set id [pop ::Undo]
    if {$id ne ""} {
        push ::Redo [item'dump $w $id]
        $w delete $id
    } ;# else Undo stack was empty
}
proc redo w {
    set data [pop ::Redo]
    if {[llength $data]} {
        push ::Undo [eval [linsert $data 0 $w create]]
    } ;# else Redo stack was empty
}
#-- description of a canvas item: type, coords, -key val... switches
proc item'dump {w id} {
    set res [$w type $id]
    lappend res [$w coords $id]
    foreach i [$w itemconfigure $id] {
        lappend res [lindex $i 0] [lindex $i end]
    }
    set res
}
#-- Stack routines (see [Stacks and queues]):
interp alias {} push {} lappend
proc pop {_stack} {
    upvar 1 $_stack stack
    K [lindex $stack end] [set stack [lrange $stack 0 end-1]]
}
proc K {a b} {set a}
#-- Testing the whole thing:
pack [frame .f]  -fill x -expand 1
button .f.undo -text Undo -command {undo .c}
button .f.redo -text Redo -command {redo .c}
eval pack [winfo children .f] -side left
set Undo {}; set Redo {}

pack [canvas .c -background white] -fill both -expand 1
bind .c <1>         {newLine .c %x %y}
bind .c <B1-Motion> {drawLine .c %x %y}