# # $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/tcl80.tcl,v $ # $Date: 2001/07/20 06:52:42 $ # $Revision: 1.18.1.12 $ # # ---------------------------------------------------------------------- # AUTHOR: Lindsay Marshall <lindsay.marshall@newcastle.ac.uk> # ---------------------------------------------------------------------- # Copyright 2000 The University of Newcastle upon Tyne (see COPYRIGHT) # ====================================================================== # # package provide interp 8.0 # proc sconf {sk enc} { global hostIPaddress fconfigure $sk -buffering line -translation {auto lf} -blocking 0 if {![info exists hostIPaddress]} { if {![catch {fconfigure $sk -sockname} xx]} { set hostIPaddress [lindex $xx 0] } } } # proc filecopy {f1 f2} { file copy -- $f1 $f2 } # proc filerename {f1 f2} { file rename -force -- $f1 $f2 } # proc filemkdir {f1} { file mkdir $f1 } # proc filedelete {f1} { file delete -- $f1 } # proc filedirdel {f1} { file delete -force -- $f1 } # proc sendSound {net nk} { global SoundDir zircon if {![info exists SoundDir($net)]} { if {[file exists [file join $zircon(prefdir) sounds]]} { set SoundDir($net) [file join $zircon(prefdir) sounds] } { set SoundDir($net) [file join $zircon(lib) sounds] } } set fts {} foreach x [$net players] { lappend fts [list [lindex $x 3] [lindex [lindex $x 0] 0]] } lappend fts [list {All files} {*.*}] if {[catch {tk_getOpenFile -defaultextension wav \ -filetypes $fts -initialdir $SoundDir($net)} sfl]} { $net errmsg "File error: $sfl" } { doSendSound $net $nk $sfl } } # proc native {fl} { return [file nativename $fl] } # proc ncsort {lst} { return [lsort -dictionary $lst] } # proc safeUnset {args} { foreach x $args { catch {uplevel #0 unset [list $x]} }}