## ******************************************************** 
 ##
 ## 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