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
