blob: cfe1fde4f8463d9d1c3ce009ff90d92baebf57bf (
plain)
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
|
# msgcat.tcl --
#
# This file defines various procedures which implement a
# message catalog facility for Tcl programs. It should be
# loaded with the command "package require msgcat".
#
# Copyright (c) 1998 by Mark Harrison.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# $Id: msgcat.tcl,v 1.1.2.1 1998/12/04 18:52:40 stanton Exp $
#
#---------------------------------------------------------------
# message catalog procedures
#---------------------------------------------------------------
namespace eval msgcat {
set _locale ""
set _loclist {}
proc mc {src} {
set ns [uplevel {namespace current}]
foreach loc $::msgcat::_loclist {
if {[info exists ::msgcat::_msg($loc,$ns,$src)]} {
return $::msgcat::_msg($loc,$ns,$src)
}
}
# we have not found the translation
return [mcunknown $::msgcat::_locale $src]
}
proc mclocale {args} {
set len [llength $args]
if {$len == 0} {
return $::msgcat::_locale
} elseif {$len == 1} {
set ::msgcat::_locale $args
set ::msgcat::_loclist {}
set word ""
foreach part [split $args _] {
set word [string trimleft "${word}_${part}" _]
set ::msgcat::_loclist \
[linsert $::msgcat::_loclist 0 $word]
}
} else {
# incorrect argument count
error {called "mclocale" with too many arguments}
}
}
proc mcpreferences {} {
return $::msgcat::_loclist
}
proc mcload {langdir} {
foreach p [::msgcat::mcpreferences] {
set langfile $langdir/$p.msg
if {[file exists $langfile]} {
uplevel [list source $langfile]
}
}
}
proc mcset {locale src {dest ""}} {
if {[string compare "" $dest] == 0} {
set dest $src
}
set ns [uplevel {namespace current}]
set ::msgcat::_msg($locale,$ns,$src) $dest
}
proc mcunknown {locale src} {
return $src
}
# set default locale try to get from environment
if {[info exists ::env(LANG)]} {
mclocale $::env(LANG)
} else {
mclocale "C"
}
namespace export mc mcset mclocale mclocales mcunknown
}
package provide msgcat 1.0
#eof: msgcat.tcl
|