1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
|
# $Id: configdir.tcl 1123 2007-04-22 06:46:44Z sergei $
# 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 [format [::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
|
