## ********************************************************
##
## 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 glob-sensitive characters (which are hard to write in the Wiki). This requires Tcl 8.3
Francois Vogel December 04 2005 The above code goes into an infinite loop if called with levels==0. I fixed it by adding:
if {$levels==0} {return}