/[webpac]/openisis/current/tcl/lib/mlcm.lang.tcl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /openisis/current/tcl/lib/mlcm.lang.tcl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 237 - (hide annotations)
Mon Mar 8 17:43:12 2004 UTC (20 years, 1 month ago) by dpavlin
File MIME type: application/x-tcl
File size: 3252 byte(s)
initial import of openisis 0.9.0 vendor drop

1 dpavlin 237
2     package provide mlcm::lang 0.1
3    
4     namespace eval mlcm::lang {
5    
6     array set _keys {}
7     array set _dbs {}
8     # default lang: en
9     set _alang ""
10     set _keydb ""
11     set _stb ""
12    
13     # loads some defaults
14     proc init {} {
15     variable _stb
16     set _stb [ openIsis ]
17     $_stb add syspath /opt/openisis/db
18     set lang "en"
19     loadmap ""
20     load $lang ""
21     activate $lang
22     }
23    
24     # loads a key -> value mapping for messages
25     # @param stb db stub to be used
26     # @param path db holding the (reverse) key value mappings
27     # the mfn stands for the message id, tag 0 for the key
28     proc loadmap { path } {
29     variable _stb
30     variable _keydb
31     if { "" == $path } {
32     set syspath [$_stb get .syspath ]
33     set path "$syspath/msg/key"
34     }
35     $_stb req type open db $path
36     set err [openIsis::errno $_stb]
37     if { $err } {
38     puts "WARNING: could not open key map db @ $path"
39     return -1
40     } else {
41     puts "opened key db on path $path"
42     }
43     set _keydb [ $_stb .res get db ]
44     }
45    
46     # loads a message set for a specific language
47     # @param stb db stub to be used
48     # @param lang the language key to access the message set;
49     # should be a two-letter language code
50     # @param path db holding the message set; the message db
51     # is compatible to the WinISIS style
52     # @return 0 on success else the openisis error code
53     proc load { lang path } {
54     variable _stb
55     variable _dbs
56    
57     # no db path given; revert to default
58     if { "" == $path } {
59     set syspath [$_stb get .syspath ]
60     set path "$syspath/msg/ms$lang"
61     }
62    
63     puts "using msgdb path: $path for lang $lang"
64    
65     $_stb req type open db $path
66     set err [openIsis::errno $_stb]
67    
68     if { $err } { return $err }
69    
70     openIsis::prnres "open $path" $_stb
71     set _dbs($lang) $path
72     }
73    
74     # activates a given lang if previously loaded
75     proc activate { lang } {
76     variable _alang
77     variable _dbs
78     set db ""
79     if { [ catch { set db $_dbs($lang) } ] } {
80     puts "Language $lang not loaded"
81     } else {
82     set _alang "$lang"
83     puts "Language $lang now active"
84     }
85     }
86    
87     # returns a raw msg
88     proc rawMsg { key } {
89     variable _stb
90     variable _alang
91     variable _dbs
92     set id [ _lookup $key ]
93     if { $id } {
94     incr id -1
95     set msg [ _xlate $id ]
96     if { "" != $msg } { return $msg }
97     }
98     return $key
99     }
100    
101     # returns a msg w/o any appended command
102     proc strippedMsg { key } {
103     return [_cleanCmd [rawMsg $key ]]
104     }
105    
106     # returns a completely cleaned msg
107     proc msg { key } {
108     return [_cleanAmp [strippedMsg $key]]
109     }
110    
111     # looks up a key from the
112     proc _lookup { key } {
113     variable _stb
114     variable _dbs
115     variable _keydb
116     $_stb req type query mode 0 key $key db $_keydb
117     set size [$_stb .res get size]
118     if { 1 != $size } { return 0 }
119     set id [$_stb .res get rowid]
120     return $id
121     }
122    
123     # translates a message id to the given lang
124     proc _xlate { id } {
125     variable _stb
126     variable _alang
127     variable _dbs
128    
129     set mfn [ expr {$id/10+1} ]
130     set tag [ expr {[expr {$id+1}]%10} ]
131     $_stb req type read rowid $mfn db $_dbs($_alang)
132     set size [$_stb .res get size]
133     if { ! $size } { return "" }
134     set msg [lindex [$_stb .res .rec get $tag ] 0 ]
135     return $msg
136     }
137    
138     # cleans msg from appended command
139     proc _cleanCmd msg {
140     regsub {\[.*\]} $msg {} msg
141     return $msg
142     }
143    
144     # cleans msg from ampersands
145     proc _cleanAmp msg {
146     regsub -all {\&} $msg {} msg
147     return $msg
148     }
149    
150     }

  ViewVC Help
Powered by ViewVC 1.1.26