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

----
[LES] on Feb 15 2006: Maybe I am just doing something wrong, but the proc above doesn't really work as expected for me. So I took my own stab at it:

 proc bak { fname { levels 5 } } {
 
 	if  	{ ![ file exists [ file normalize "$fname" ] ] }   { 
 		return "$fname: no such file"
 	}
 
 	set copies [ list $fname ${fname}.bkp ]
 
 	for  	{ set i 1 }  { $i <= $levels }  { incr i }  	{
 			lappend copies "${fname}.bkp${i}"
 	}
 
 	while  	{ [ llength $copies ] >= 2 }  	{ 
 		set _source [ file normalize "[ @ [ lrange $copies end-1 end ] 0 ]" ]
 		set _target [ file normalize "[ @ [ lrange $copies end-1 end ] 1 ]" ]
 		if  	{ [ file exists $_source ] }  	{ 
 			file copy -force $_source  $_target
 		}
 		set copies [ lreplace $copies end end ]
 	}
 }
 

----
[Category File]