## ********************************************************
##
## Name: bak
##
## Description:
## Create backup files as necessary to avoid overwrites.
##
## Parameters:
##
## Usage:
## before writing to a file $fname, call: bak $fname
## and the file will not get overwritten.
##
## renames like so: .bak, .ba2, .ba3, .ba4, etc.
##
## Comments:
##
proc bak { fname { levels 10 } } {
if { [ catch {
if { [ file exists $fname ] } {
set dir [ file dirname $fname ]
set files [ glob -nocomplain -path ${fname} .ba* ]
set i $levels
while { [ incr i -1 ] } {
if { [ lsearch -exact $files ${fname}.ba$i ] > -1 } {
file rename -force ${fname}.ba$i ${fname}.ba[ incr i ]
incr i -1
}
}
if { [ file exists ${fname}.bak ] } {
file rename -force ${fname}.bak ${fname}.ba2
}
file rename -force $fname ${fname}.bak
}
} err ] } {
return -code error "bak($fname $levels): $err"
}
}
## ********************************************************Vince updated example so works even if 'fname' contains strange characters like {[}*?. This requires Tcl 8.3