# overloading of open and close #
# rename the "official commands
rename open __open
rename close __close
# rename fconfigure __fconfigure
# rename file __file
# overloaded open which registers file and fid info
# for files
proc open { args } {
if { [ llength $args ] == 1 } {
set args [ lindex $args 0 ]
}
set fid [ eval __open $args ]
set file [ lindex $args 0 ]
lappend ::open_files_array(fid,$fid) $file
lappend ::open_files_array(file,$file) $fid
return $fid
}
# overloaded close which lets you close a file i.d.,
# a socket i.d., or all the file i.d.'s associated
# with a file name.
proc close { args } {
if { [ llength $args ] == 1 } {
set args [ lindex $args 0 ]
}
foreach arg $args {
set type [ list ]
if { [ regexp {^(sock|file)\d+$} $arg -> type ] } {
__close $arg
}
if { [ catch {
switch -exact $type {
file {
set file [ managearray $arg [ fid2file $arg ] ]
}
sock {
}
default {
set fids [ file2fid $arg ]
after 10 close $fids
}
}
} err ] } {
return -code error "$arg not found"
}
}
if { [ info exists file ] } {
return $file
}
}
# proc file { args } {
# your code here!
# }
# proc fconfigure { args } {
# your code here!
# }
# helper functions
# given a fid, return the filename
proc fid2file { fid } {
return $::open_files_array(fid,$fid)
}
# given a filename return all open fids
proc file2fid { file } {
return $::open_files_array(file,$file)
}
# manage the arrays
proc managearray { fid file } {
unset ::open_files_array(fid,$fid)
set i [ lsearch $::open_files_array(file,$file) $fid ]
set ::open_files_array(file,$file) \
[ lreplace $::open_files_array(file,$file) $i $i ]
if { ! [ llength $::open_files_array(file,$file) ] } {
unset ::open_files_array(file,$file)
}
return $file
}