summaryrefslogtreecommitdiffstats
path: root/library/msgcat1.0/msgcat.tcl
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