/[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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

1
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