home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / tcl / spectcl-.000 / spectcl- / usr / local / SpecTcl-0.1a / undo.tk < prev   
Encoding:
Text File  |  1995-11-06  |  3.0 KB  |  115 lines
  1. # SpecTcl, by S. A. Uhler
  2. # Copyright (c) 1994-1995 Sun Microsystems, Inc.
  3. #
  4. # See the file "license.txt" for information on usage and redistribution
  5. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  6. #
  7. # This will be undo someday
  8. # for now, just keep a transaction log
  9. # The strategy is to minimize the overhead for keeping an undo log, 
  10. # and pay the price only when undo is needed
  11.  
  12. # any time an item is added to the "undo" log, look at the xaction type
  13. # and run a proc to extract any additional state needed to undo the operation
  14. # The state should be stored as part of the undo log.
  15. # When undo is requested, foreach entry in the current undo-log, run a
  16. # proc that knows how to "undo" the operation , given the info in the log
  17. # I'll have to determine and document the log format some day
  18.  
  19. # mark the start of an undo transaction
  20.  
  21. set Undo_count 0
  22. proc undo_mark {{why ""}} {
  23.     global Undo_count Undo_log
  24.     if {[catch {.buttons.undo configure -state normal \
  25.             -text "undo\n([incr Undo_count])"}]} {
  26.         return 0
  27.     }
  28.     # lappend Undo_log($Undo_count) $why
  29.     return 1
  30. }
  31.  
  32. # add an entry onto the undo log
  33.  
  34. proc undo_log {type args} {
  35.     global Undo_count Undo_log Current
  36.     set Current(dirty) 1
  37.     if {!$Undo_count} {return 0}
  38.     lappend Undo_log($Undo_count) "$type $args"
  39.     return $Undo_count
  40. }
  41.  
  42. # reset the undo log
  43.  
  44. proc undo_reset {}  {
  45.     global Undo_count Undo_log
  46.     set Undo_count 0
  47.     catch {unset Undo_log}
  48.     catch {.buttons.undo configure -state disabled -text undo}
  49. }
  50.  
  51. # undo the last entry in the undo log
  52.  
  53. proc undo {} {
  54.     global Undo_count Undo_log
  55.     foreach i $Undo_log($Undo_count) {
  56.         puts "Undo: undo:$i"
  57.         catch undo:$i
  58.     }
  59.     unset Undo_log($Undo_count)
  60.     if {[incr Undo_count -1] <= 0} {
  61.         .buttons.undo configure -state disabled -text undo
  62.     } else {
  63.         .buttons.undo configure -text "undo\n($Undo_count)"
  64.     }
  65. }
  66.  
  67. # some demo undo functions
  68.  
  69. # un-delete a widget
  70. # Don't check to make sure its location is valid, as (presumably)
  71. # it must be (ha)
  72.  
  73. proc undo:delete_widget {name} {
  74.     global $name Widget_data
  75.     upvar #0 $name data
  76.     puts "Undeleting widget $name, master $data(master)"
  77.     set reborn [widget_configure $name]
  78.     outline_create $reborn
  79.     bindtags $reborn "widget [bindtags $reborn]"
  80.     update_table .can.f$data(master) undelete-widget
  81. }
  82.  
  83. proc undo:delete_frame {name rows cols} {
  84.     global $name Widget_data
  85.     upvar #0 $name data
  86.     puts "Undeleting widget $name, master $data(master)"
  87.     set reborn [widget_configure $name]
  88.     outline_create $reborn
  89.     frame_create $name $rows $cols
  90.     bindtags $reborn "widget [bindtags $reborn]"
  91.     update_table .can.f$data(master) undelete-widget
  92. }
  93.  
  94. # un-create a widget
  95.  
  96. proc undo:create_widget {name} {
  97.     upvar #0 $name data
  98.     puts "Uncreating widget $name"
  99.     delete_selected_widget .can.f$data(pathname)
  100. }
  101.  
  102. # un-create a slot
  103. #  master: name of the table
  104. #  what:   row or column
  105. #  index:  which one (internal coordinates)
  106.  
  107. proc undo:create_slot {master what index} {
  108.     puts "un-creating arrow $master $what $index"
  109.     table_delete $master $what $index
  110.     grid_remove $master $what
  111.     arrow_delete .can $what $master
  112.     update_table .can.f "uncreate grid"
  113. }
  114.  
  115.