Updated 2008-04-01 11:42:40 by LV

Bezoar (03/30/08) Made minor changes to make program portable.

WJG (04/11/06) One of the frustrating things about editing an existing text file is not making a security backup before the edit job begins. Sure, we can make back-ups as we go along, but a typical application may only perform 2 or 3 saves which will still include the most recent changes. Some editing applications (text or graphics) provide a handy revert to original function, and here's a Tcl/Tk version of this that I've just cooked up. Also included is a simple checking function to test whether the current file has been saved or not. If a file has been saved, then the associated button and menu items will be deactivated with the corresponding changes to the icons giving visual feedback. If a file has been modified and not saved before exit, then the user will be prompted to save or discard changes. For the simplicity's sake, the demo program merely loads/saves a file named 'test.txt'.
 #---------------
 # revert.tcl
 #---------------
 # William J Giddings, 2006
 #
 # The following routines:
 #   1) gives the the user the option to save open text documents that have not been yet saved.
 #   2) modifies menu and toolbar buttons to indicate if the current data has been saved or not.
 #   3) provides 'revert' option for files opened for re-editing, deletes text undo/redo history.
 #
 # Notes:
 #   To implement the revert function, a copy of any opened document is made in the system applications data
 #   directory for the calling programme. The actual location of this file may vary from system to system.
 #   The file is delete on exit.
 #
 #---------------

 #---------------
 # initialise autosave
 # args:
 # w  pathName of text widget associated with file i/o operations
 # b  pathName of associated save button
 # m  pathName of menu containing save entry
 # i  index of save entry in associated menu
 #---------------
 proc save:init {w b m i} {

  # create package specific namespace
  namespace eval ::save {}
  set ::save::save 0        ;# saved condition of the open document
  set ::save::button $b     ;# pathName of associated save button
  set ::save::menu $m       ;# pathName of menu containing save entry
  set ::save::menuIndex $i  ;# index of save entry in associated menu

  # create text bindings, reset button and menu item
  bind $w <Key> "
      $b configure -state normal
      $m entryconfigure $i -state normal
      set ::save::save 1
      "
 }

 #---------------
 # reset condition flag and associated button/menu item
 #---------------
 proc save:reset {} {
  set ::save::save 1
  $::save::button configure -state normal
  $::save::menu entryconfigure $::save::menuIndex -state normal
 }

 #---------------
 # set flags to incicate that current document is saved
 #---------------
 proc save:me {} {
    $::save::button configure -state disabled
    $::save::menu entryconfigure $::save::menuIndex -state disabled
    set ::save::save 0
 }

 #---------------
 # save a revert copy of the most recenty opened document
 # call from within file loading proceedures
 # args:
 # fname  name of file most recently loaded
 #---------------
 proc revert:save {fname} {
  file copy -force $fname [file join $::revert::targetDir revert.tmp ]
  set ::revert::firstTime 0
  # enable 'revert' option in the associated menu
  $::revert::menu entryconfigure $::revert::index -state normal
 }

 #---------------
 # delete revert copy file, called prior to program exit
 #---------------
 proc revert:exit {} {
  file delete -force [file join $::revert::targetDir revert.tmp ]
 }

 #---------------
 # the content here will depend upon application data file parsing
 #---------------
 proc revert:load {} {
  # will cause error if edited file was not loaded from disk
  if {!$::revert::firstTime} {
    set fp [open [file join $::revert::targetDir revert.tmp ] "r"]
    $::revert::text delete 1.0 end
    $::revert::text insert end [gets $fp]
    close $fp
  }
 }

 #---------------
 # initialise revert package
 # args:
 # w  pathName of associated text widget
 # m  pathName of menu containing the 'revert' option
 # i  index of 'revert' option in the associated menu
 #---------------
 proc revert:init {w m i} {
  namespace eval ::revert {}
  set ::revert::text $w      ;# pathName of associated text widget
  set ::revert::firstTime 1  ;# flag to monitor if a 'revert' copy exists
  set ::revert::menu $m      ;# pathName of menu containing the 'revert' option
  set ::revert::index $i     ;# index of 'revert' option in the associated menu

  # build pathname to directory in which to save application temporary data
    if { [ string equal $::tcl_platform(platform) "unix" ] } {
         set ::revert::targetDir  [file join $::env(HOME) .[file rootname [ file tail $::argv0 ] ] ]
    } else {
	 set ::revert::targetDir [file join $::env(HOME) "Application Data" [file rootname [file tail $::argv0] ] ]
    }
    # create application data directory if necessary
    file mkdir $::revert::targetDir
    # add revert item to specified menu
    $m insert $i command -label Revert -command revert:load -state disabled
  }

 #---------------
 # reset revert flags and menu items
 #---------------
 proc revert:reset {} {
  set ::revert::firstTime 1  ;# flag to monitor if a 'revert' copy exists
  # disable 'revert' option in the associated menu until a file is loaded
  $::revert::menu entryconfigure $::revert::index -state disabled
 }

 #---------------
 # test application main proc
 #---------------
 proc main {} {

  # button graphics
  image create photo save -data {R0lGODlhEAAQAMQAAP////7+/fnv7+/39+/v9+rr69jY2NTQyM7e3re3t7bP0am1taioqI+xtoyYmIyUiXulrXuMjHOcrWZmZGNzc1Jze1Jrc0pjY0pSWkVGREJaYzVCSgAAAAAAAAAAAAAAACwAAAAAEAAQAAAFauAhjiPHkWjJSWeqKkphuiasBAOL1nfg+zMRp4H4GQOyUmRw/BGCB06hOShIdMIG01e9WixQKfeqwVSurWiDYNUw2BN0eiWxDKqFxUWzmTfqGxAGBQkUaSVXAgsGDxmHJRcSBg5QNCaPIiEAOw==}

  # create menus
  menu .menubar -type menubar
  . configure -menu .menubar

  # add file menu
  menu .menubar.file -tearoff 0
  .menubar add cascade -label File -menu .menubar.file

  # add edit menu
  menu .menubar.edit -tearoff 0
  .menubar add cascade -label Edit -menu .menubar.edit

  # file menu options
  .menubar.file add command -label New -command file:new
  .menubar.file add command -label Open -command file:open
  .menubar.file add command -label Save -compound left -image save -command file:save
  .menubar.file add separator
  .menubar.file add command -label Quit -command file:quit

  # edit menu options
  .menubar.edit add command -label Undo -command edit:undo
  .menubar.edit add command -label Redo -command edit:redo
  .menubar.edit add separator
  .menubar.edit add command -label Cut -command edit:cut
  .menubar.edit add command -label Copy -command edit:copy
  .menubar.edit add command -label Paste -command edit:paste
  .menubar.edit add command -label Delete -command edit:delete

  pack [frame .fr] -side top -anchor nw -fill x
  pack [button .fr.but1 -image save -command file:save -borderwidth 0] -side left

  pack [text .txt] -side top -anchor nw -fill both

  revert:init .txt .menubar.file 3
  save:init .txt .fr.but1 .menubar.file 2

  # exit prooperly..
  wm protocol . WM_DELETE_WINDOW { file:quit }
 }

 #---------------
 # proceedures called from menus and buttons
 #---------------
 proc file:new {} {
  save:reset
  revert:reset
  .txt delete 1.0 end
 }

 proc file:open {} {
  save:reset
  revert:save test.txt
  .txt delete 1.0 end
  set fp [open test.txt r]
  .txt insert end [read $fp]
  close $fp
 }

 proc file:save {} {
  save:me
  # test save block..
  set fp [open test.txt w]
  puts $fp [.txt get 1.0 end]
  close $fp
 }

 proc file:revert {} {
  revert:load
 }

 proc file:quit {} {
  if {$::save::save} {
      if { [tk_dialog .foo "Save File.." "Save document changes?" \
        questhead 0 "  Yes  " "   No   "]} {
        # save file
        set fp [open test.txt "w"]
        puts $fp [.txt get 1.0 end]
        close $fp
      }
    }
  revert:exit
  exit
 }

 # run test application
 main

[Category Example