[Tom Wilkason] - Many folks have requested a undo/redo mechanism for Tk over the years. An excellent one was implemented by Jean-Luc Fontaine (I think, correct this if wrong). I modified it slightly to support undo reset and not collide with Itcl class keyword. Below is the script made as a package. At the bottom is a short demo on how to hook it in. - TFW

----

'''In Tcl/Tk 8.4 it's all done for you with the -undo flag.'''

----

[Bryan Oakley]'s supertext widget has undo capabilities built in. It's behavior is slightly different than the below code, in that the supertext can also undo "undone" text (it is modeled after emacs). Contrast that to the code below which uses a separate action to undo undone text (ie: redo). As a side effect, the supertext version lets you undo absolutely everything, but the undo/redo mechanism doesn't. Also, the code below implements "undo reset", which was unfortunately left out of the supertext widget (though it's easy to add).

Some may prefer one behavior over the other. Plus, the supertext widget is a complete widget rather than a set of procs to attach to a plain widget, though it would probably be easy to extract the undo code. That might make for a nice project for someone...

The supertext widget can be found here: http://www1.clearlight.com/~oakley/tcl/

It's interesting to note that both solutions are approximately the same number of lines of code -- mid-200's sans comments -- though supertext has more comments :-)

----
 
 ;# *************************************************************************
 ;# * File   : undoer.tcl
 ;# * Purpose: Implement an undo/redo facility for a text widget
 ;# *
 ;# * Author : Tom Wilkason lifted from code by Jean-Luc Fontaine
 ;#
 ;# * Dated  : 9/3/2000
 ;# *
 ;# *************************************************************************
 set RH {
   Revision History:
   -----------------
   $Revision: 1.3 $
   $Log: 1333,v $
   Revision 1.3  2002-09-30 08:00:20  jcw
   1333-1033361596-24.42.208.231

 }
 
 if {![info exists classNewId]} {
     # work around object creation between multiple include of this file problem
     set classNewId 0
 }
 ;##
 ;# Call this to get a new undoer for some text widget
 ;# e.g. UnDonew textUndoer .text.widget
 ;#
 proc UnDonew {className args} {
     # calls the constructor for the class with optional arguments
     # and returns a unique object identifier independent of the class name
 
     global classNewId
     # use local variable for id for new can be called recursively
     set id [incr classNewId]
     if {[llength [info procs ${className}:$className]]>0} {
         # avoid catch to track errors
         eval ${className}:$className $id $args
     }
     return $id
 }
 
 proc UnDodelete {className id} {
     # calls the destructor for the class and UnDodelete all the object data members
 
     if {[llength [info procs ${className}:~$className]]>0} {
         # avoid catch to track errors
         catch {${className}:~$className $id}
     }
     global $className
     # and UnDodelete all this object array members if any (assume that they were stored as $className($id,memberName))
     foreach name [array names $className "$id,*"] {
         unset ${className}($name)
     }
 }
 
 proc udLifo:udLifo {id {size 2147483647}} {
     global udLifo
     set udLifo($id,maximumSize) $size
     udLifo:empty $id
 }
 
 proc udLifo:push {id data} {
     global udLifo saveTextMsg
     set saveTextMsg 1
     udLifo:tidyUp $id
     if {$udLifo($id,size)>=$udLifo($id,maximumSize)} {
         unset udLifo($id,data,$udLifo($id,first))
         incr udLifo($id,first)
         incr udLifo($id,size) -1
     }
     set udLifo($id,data,[incr udLifo($id,last)]) $data
     incr udLifo($id,size)
 }
 
 proc udLifo:pop {id} {
     global udLifo saveTextMsg
     set saveTextMsg 1
     udLifo:tidyUp $id
     if {$udLifo($id,last)<$udLifo($id,first)} {
         error "udLifo($id) pop error, empty"
     }
     # delay unsetting popped data to improve performance by avoiding a data copy
     set udLifo($id,unset) $udLifo($id,last)
     incr udLifo($id,last) -1
     incr udLifo($id,size) -1
     return $udLifo($id,data,$udLifo($id,unset))
 }
 
 proc udLifo:tidyUp {id} {
     global udLifo
     if {[info exists udLifo($id,unset)]} {
         unset udLifo($id,data,$udLifo($id,unset))
         unset udLifo($id,unset)
     }
 }
 
 proc udLifo:empty {id} {
     global udLifo
     udLifo:tidyUp $id
     foreach name [array names udLifo $id,data,*] {
         unset udLifo($name)
     }
     set udLifo($id,size) 0
     set udLifo($id,first) 0
     set udLifo($id,last) -1
 }
 
 proc textUndoer:textUndoer {id widget {depth 2147483647}} {
     global textUndoer
 
     if {[string compare [winfo class $widget] Text]!=0} {
         error "textUndoer error: widget $widget is not a text widget"
     }
     set textUndoer($id,widget) $widget
     set textUndoer($id,originalBindingTags) [bindtags $widget]
     bindtags $widget [concat $textUndoer($id,originalBindingTags) UndoBindings($id)]
 
     bind UndoBindings($id) <Control-u> "textUndoer:undo $id"
 
     # self destruct automatically when text widget is gone
     bind UndoBindings($id) <Destroy> "UnDodelete textUndoer $id"
 
     # rename widget command
     rename $widget [set textUndoer($id,originalCommand) textUndoer:original$widget]
     # and intercept modifying instructions before calling original command
     proc $widget {args} "textUndoer:checkpoint $id \$args;
       global search_count;
       eval $textUndoer($id,originalCommand) \$args"
 
     set textUndoer($id,commandStack) [UnDonew udLifo $depth]
     set textUndoer($id,cursorStack) [UnDonew udLifo $depth]
     #lee
     textRedoer:textRedoer $id $widget $depth
 }
 
 proc textUndoer:~textUndoer {id} {
     global textUndoer
 
     bindtags $textUndoer($id,widget) $textUndoer($id,originalBindingTags)
     rename $textUndoer($id,widget) ""
     rename $textUndoer($id,originalCommand) $textUndoer($id,widget)
     UnDodelete udLifo $textUndoer($id,commandStack)
     UnDodelete udLifo $textUndoer($id,cursorStack)
     #lee
     textRedoer:~textRedoer $id
 }
 
 proc textUndoer:checkpoint {id arguments} {
     global textUndoer textRedoer
 
     # do nothing if non modifying command
     if {[string compare [lindex $arguments 0] insert]==0} {
         textUndoer:processInsertion $id [lrange $arguments 1 end]
         if {$textRedoer($id,redo) == 0} {
            textRedoer:reset $id
         }
     }
     if {[string compare [lindex $arguments 0] delete]==0} {
         textUndoer:processDeletion $id [lrange $arguments 1 end]
         if {$textRedoer($id,redo) == 0} {
            textRedoer:reset $id
         }
     }
 }
 
 proc textUndoer:processInsertion {id arguments} {
     global textUndoer
 
     set number [llength $arguments]
     set length 0
     # calculate total insertion length while skipping tags in arguments
     for {set index 1} {$index<$number} {incr index 2} {
         incr length [string length [lindex $arguments $index]]
     }
     if {$length>0} {
         set index [$textUndoer($id,originalCommand) index [lindex $arguments 0]]
         udLifo:push $textUndoer($id,commandStack) "delete $index $index+${length}c"
         udLifo:push $textUndoer($id,cursorStack) [$textUndoer($id,originalCommand) index insert]
     }
 }
 
 proc textUndoer:processDeletion {id arguments} {
     global textUndoer
 
     set command $textUndoer($id,originalCommand)
     udLifo:push $textUndoer($id,cursorStack) [$command index insert]
 
     set start [$command index [lindex $arguments 0]]
     if {[llength $arguments]>1} {
         udLifo:push $textUndoer($id,commandStack) "insert $start [list [$command get $start [lindex $arguments 1]]]"
     } else {
         udLifo:push $textUndoer($id,commandStack) "insert $start [list [$command get $start]]"
     }
 }
 
 proc textUndoer:undo {id} {
     global textUndoer
 
     if {[catch {set cursor [udLifo:pop $textUndoer($id,cursorStack)]}]} {
         return
     }
 
     if {[catch {set popArgs [udLifo:pop $textUndoer($id,commandStack)]}]} {
         return
     }
     textRedoer:checkpoint $id $popArgs
 
     eval $textUndoer($id,originalCommand) $popArgs
     # now restore cursor position
     $textUndoer($id,originalCommand) mark set insert $cursor
     # make sure insertion point can be seen
     $textUndoer($id,originalCommand) see insert
 }
 
 
 proc textUndoer:reset {id} {
     global textUndoer
     udLifo:empty $textUndoer($id,commandStack)
     udLifo:empty $textUndoer($id,cursorStack)
 }
 
 #########################################################################
 proc textRedoer:textRedoer {id widget {depth 2147483647}} {
     global textRedoer
     if {[string compare [winfo class $widget] Text]!=0} {
         error "textRedoer error: widget $widget is not a text widget"
     }
     set textRedoer($id,commandStack) [UnDonew udLifo $depth]
     set textRedoer($id,cursorStack) [UnDonew udLifo $depth]
     set textRedoer($id,redo) 0
 }
 
 proc textRedoer:~textRedoer {id} {
     global textRedoer
     UnDodelete udLifo $textRedoer($id,commandStack)
     UnDodelete udLifo $textRedoer($id,cursorStack)
 }
 
 
 proc textRedoer:checkpoint {id arguments} {
     global textUndoer textRedoer
     # do nothing if non modifying command
     if {[string compare [lindex $arguments 0] insert]==0} {
         textRedoer:processInsertion $id [lrange $arguments 1 end]
     }
     if {[string compare [lindex $arguments 0] delete]==0} {
         textRedoer:processDeletion $id [lrange $arguments 1 end]
     }
 }
 
 proc textRedoer:processInsertion {id arguments} {
     global textUndoer textRedoer
     set number [llength $arguments]
     set length 0
     # calculate total insertion length while skipping tags in arguments
     for {set index 1} {$index<$number} {incr index 2} {
         incr length [string length [lindex $arguments $index]]
     }
     if {$length>0} {
         set index [$textUndoer($id,originalCommand) index [lindex $arguments 0]]
         udLifo:push $textRedoer($id,commandStack) "delete $index $index+${length}c"
         udLifo:push $textRedoer($id,cursorStack) [$textUndoer($id,originalCommand) index insert]
     }
 }
 
 proc textRedoer:processDeletion {id arguments} {
     global textUndoer textRedoer
     set command $textUndoer($id,originalCommand)
     udLifo:push $textRedoer($id,cursorStack) [$command index insert]
 
     set start [$command index [lindex $arguments 0]]
     if {[llength $arguments]>1} {
         udLifo:push $textRedoer($id,commandStack) "insert $start [list [$command get $start [lindex $arguments 1]]]"
     } else {
         udLifo:push $textRedoer($id,commandStack) "insert $start [list [$command get $start]]"
     }
 }
 proc textRedoer:redo {id} {
     global textUndoer textRedoer
     if {[catch {set cursor [udLifo:pop $textRedoer($id,cursorStack)]}]} {
         return
     }
     set textRedoer($id,redo) 1
     set popArgs [udLifo:pop $textRedoer($id,commandStack)]
     textUndoer:checkpoint $id $popArgs
     eval $textUndoer($id,originalCommand) $popArgs
     set textRedoer($id,redo) 0
     # now restore cursor position
     $textUndoer($id,originalCommand) mark set insert $cursor
     # make sure insertion point can be seen
     $textUndoer($id,originalCommand) see insert
 }
 
 ;##
 ;# Call this to reset the stacks, for example after reading a file in
 ;#
 proc textRedoer:reset {id} {
     global textRedoer
     udLifo:empty $textRedoer($id,commandStack)
     udLifo:empty $textRedoer($id,cursorStack)
 }
 package provide Undoer 1.0
 ;##
 ;# Create two text widgets, each with their own undo
 ;#
 proc textUndoer:demo {} {
       package require Undoer     ;# This implements the undo stuff
       ;# Couple of extra keys for undo/redo
       toplevel .top
       pack [text .top.text1 -width 80 -height 10] -expand true -fill both
       pack [text .top.text2 -width 80 -height 10] -expand true -fill both
       set undo_id1 [UnDonew textUndoer .top.text1]
       set undo_id2 [UnDonew textUndoer .top.text2]
       bind .top.text1 <Control-z> [list textUndoer:undo $undo_id1]
       bind .top.text2 <Control-z> [list textUndoer:undo $undo_id2]
       bind .top.text1 <Control-y> [list textRedoer:redo $undo_id1]
       bind .top.text2 <Control-y> [list textRedoer:redo $undo_id2]
 }