From: "Corey L. Carlson" <corey@itlabs.umn.edu>
Message-Id: <199803050312.VAA17434@trout.itlabs.umn.edu>
Subject: Code (open/save)
To: calvin-ui98@dagobah.stwing.upenn.edu (ui 98)
Date: Wed, 4 Mar 1998 21:12:20 -0600 (CST)
#set myfile "/home/other/corey/5110/tcltest/90210spoof"
set mylist [list test1 test2 test3 test4]
set plimp ""
set test1 fun
set test2 morefun
set test3 lotsofun
#testdata above
global sigString
set sigString "#File signature: MAC v1.0"
proc mac_save { savepath varlist {mode save} } {
global sigString
global $savepath
global $varlist
global errorInfo
if {![info exists $varlist]} {
return
}
if { $mode == "save" } {
set theway [set $savepath]
} elseif { $mode == "saveas" } {
set theway [tk_getSaveFile]
} else {
error "unexpected save mode $mode"
return
}
if { $theway == "" } {
return
}
if [catch {open $theway { WRONLY CREAT TRUNC } 0600} FILEDES] {
puts stderr "\n*** Tcl TRACE***"
puts stderr $errorInfo
error "Could not create file $theway"
} else {
puts $FILEDES $sigString
puts $FILEDES "# [clock format [clock seconds]]"
puts $FILEDES "# Filename: $theway"
foreach gvar [set $varlist] {
global $gvar
if [info exists $gvar] {
puts $FILEDES "global $gvar"
puts $FILEDES [dump var $gvar]
}
}
if [catch {close $FILEDES } result] {
puts stderr "\n*** Tcl TRACE***"
puts stderr $errorInfo
error "Could not close file $theway"
}
}
}
proc mac_source { } {
global sigString
#need to find file to open.
set filepath [tk_getOpenFile]
if { $filepath == "" } {
return
}
if [catch {open $filepath r} FILEDES] {
puts stderr "\n*** Tcl TRACE***"
puts stderr $errorInfo
error "Could not create file $theway"
} else {
set teststr [gets $FILEDES]
if {$teststr == $sigString} {
#If I get a lot of free time wrap close with a catch.
close $FILEDES
source $filepath
} else {
puts "File pattern match failed. Verify origin of file."
}
}
}
mac_save plimp mylist saveas