# $Id$ # Provides for deducing the location of Tkabber config directory depending # on the current platform. namespace eval config {} # Deduces the location of the "Application Data" directory # (in its wide sense) on the current Windows platform. # See: http://ru.tkabber.jabe.ru/index.php/Config_dir proc config::appdata_windows {} { global env if {[info exists env(APPDATA)]} { return $env(APPDATA) } if {![catch {package require registry}]} { set key {HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders} if {![catch {registry get $key AppData} dir]} { return $dir } } return {} } # Copies the contents of dir $from under dir $to using bells'n'whistles. # NOTE that at the time of invocation: # * $from MUST exist # * $to MUST NOT exist. # Returns true if copying succeeded, false otherwise. proc config::transfer_dir {from to} { wm withdraw . wm title . [::msgcat::mc "Attention"] pack [message .msg -aspect 50000 \ -text [::msgcat::mc "Please, be patient while Tkabber\ configuration directory is being transferred\ to the new location"]] -fill both -expand yes #::tk::PlaceWindow . wm deiconify . set failed [catch {file copy $from $to} err] if {$failed} { tk_messageBox -icon error \ -title [::msgcat::mc "Attention"] \ -message [::msgcat::mc "Tkabber configuration directory\ transfer failed with:\n%s\n\ Tkabber will use the old directory:\n%s" $err $from] } else { set to [file nativename $to] tk_messageBox \ -title [::msgcat::mc "Attention"] \ -message [format \ [::msgcat::mc "Your new Tkabber config\ directory is now:\n%s\nYou can delete the old one:\n%s"] \ $to $from] } destroy .msg expr {!$failed} } # Based on the current platform, chooses the location of the Tkabber's # config dir and sets the "configdir" global variable to its pathname. # "TKABBER_HOME" env var overrides any guessing. # NOTE that this proc now tries to copy contents of the "old-style" # ~/.tkabber config dir to the new location, if needed, to provide # smooth upgrade for Tkabber users on Windows. # This behaviour should be lifted eventually in the future. if {![info exists env(TKABBER_HOME)]} { switch -- $tcl_platform(platform) { unix { set configdir ~/.tkabber } windows { set dir [config::appdata_windows] if {$dir != {}} { set configdir [file join $dir Tkabber] } else { # Fallback default (depends on Tcl's idea about ~): set configdir [file join ~ .tkabber] } } macintosh { set configdir [file join ~ Library "Application Support" Tkabber] } } set env(TKABBER_HOME) $configdir } else { set configdir $env(TKABBER_HOME) } if {$tcl_version >= 8.4} { set configdir [file normalize $configdir] } # This should be lifted in the next release after introduction # of configdir. # TODO: what perms does the dest dir of [file copy] receive? # Since it's only needed for Windows, we don't really care now. if {![file exists $configdir] && [file isdir ~/.tkabber]} { if {![config::transfer_dir ~/.tkabber $configdir]} { # Transfer error-case fallback: set configdir ~/.tkabber } } file mkdir $configdir # vim:ts=8:sw=4:sts=4:noet