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
|
#!/usr/bin/env tclsh
# Written by: Alexandre Hamelin (ahamelin users sourceforge net)
# Date: Sept 2, 2003
# Usage: ./addkey.tcl
#
# Small utility to add a new message key to a language file. When the key is
# added, the language file is sorted before it is written back to the disk.
# If the key already exists in the target language file, the associated message
# will be replaced. In the latter case, the old message will be printed on
# screen first.
#
# $Id$
proc prompt {msg} {
puts -nonewline "$msg"
flush stdout
return [gets stdin]
}
proc die {msg} {
puts "error: $msg"
exit 1
}
set key [prompt "Specify a key (^C to abort): "]
set lang [prompt "Language for this key (en, fr_ca, etc.): "]
if {[catch {open lang$lang "r"} fd]} {
puts "TIP: This utility should be run from within the lang directory."
die $fd
}
# Read the content of the language file.
set lines [list]
gets $fd version
while { [gets $fd line] >= 0 } {
lappend lines $line
}
close $fd
# See whether the key exists or not.
set k [lsearch $lines "$key *"]
if {$k > -1} {
# Print the old message if the key existed.
set keytext [lindex $lines $k]
puts "-- Old message: [string repeat "-" 54]"
puts [string range $keytext [expr [string first " " $keytext]+1] end]
puts [string repeat "-" 70]
}
set msg [prompt "Enter the text for this key (<Enter> to end):\n"]
if {$k > -1} {
# Replace the text of an existing key.
lset lines $k "$key $msg"
} else {
# Add a new key.
lappend lines "$key $msg"
}
# Sort the content.
set lines [lsort $lines]
#puts stderr "WARNING: Original language file (lang$lang) will be truncated."
#puts stderr " Please press enter to continue."
#gets stdin
# Write the new language file.
if {[catch {open lang$lang "w"} fd]} {
die "$fd"
}
puts $fd $version
puts $fd [join $lines "\n"]
close $fd
|