Tcl Source Code

Changes On Branch msgcat_dyn_locale
Login
Bounty program for improvements to Tcl and certain Tcl packages.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch msgcat_dyn_locale Excluding Merge-Ins

This is equivalent to a diff from 4a7785cdf1 to 4c6197ca80

2015-06-29
21:44
[TIP 412] msgcat dynamic locale change and package private locale (msgcat 1.6.0) check-in: 392ff6199d user: oehhar tags: trunk
21:26
Added tests for mcforgetpackage, mcpackagelocale and mcpackageconfig Closed-Leaf check-in: 4c6197ca80 user: oehhar tags: msgcat_dyn_locale, tip-412
2015-06-26
15:16
Tests for mcexists and mcloadedlocales check-in: 9806884e41 user: oehhar tags: msgcat_dyn_locale
2015-06-24
13:55
Make sure that an input lying precisely 1/2 ULP between two floating point values is rounded to even... check-in: 6913079d54 user: dgp tags: core-8-5-branch
2015-06-23
13:04
If the file system changes when "cwd" changes, force a filesystem refresh on path objects. Needed fo... check-in: 48beab9ffd user: jan.nijtmans tags: trunk
2015-06-22
12:40
Merge trunk check-in: a8834249fb user: oehhar tags: msgcat_dyn_locale
2015-06-21
22:29
Branch for androwish, as help to keep track on which android-specific changes could be included into... check-in: fe175c2a4e user: jan.nijtmans tags: androwish
2015-06-20
20:44
Make sure that an input lying precisely 1/2 ULP between two floating point values is rounded to even... check-in: 4a7785cdf1 user: kbk tags: trunk
2015-06-19
15:35
Remove lines of code made obsolete by earlier changes. check-in: 83de1a781f user: dgp tags: trunk

Changes to ChangeLog.

908
909
910
911
912
913
914








915
916
917
918
919
920
921
2012-09-19  Jan Nijtmans  <[email protected]>

	* generic/tcl.h:  Make Tcl_Interp a fully opaque structure if
	TCL_NO_DEPRECATED is set (TIP 330 and 336).
	* win/nmakehlp.c: Let "nmakehlp -V" start searching digits after the
	found match (suggested by Harald Oehlmann).









2012-09-07  Harald Oehlmann  <[email protected]>

	*** 8.6b3 TAGGED FOR RELEASE ***

	IMPLEMENTATION OF TIP#404.







>
>
>
>
>
>
>
>







908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
2012-09-19  Jan Nijtmans  <[email protected]>

	* generic/tcl.h:  Make Tcl_Interp a fully opaque structure if
	TCL_NO_DEPRECATED is set (TIP 330 and 336).
	* win/nmakehlp.c: Let "nmakehlp -V" start searching digits after the
	found match (suggested by Harald Oehlmann).

2012-09-19  Harald Oehlmann  <[email protected]>

	IMPLEMENTATION OF TIP#412.

	* library/msgcat/msgcat.tcl:	dynamic locale change with mc file
	* library/clock.tcl:            load on locale change.
	clock uses new msgcat features.

2012-09-07  Harald Oehlmann  <[email protected]>

	*** 8.6b3 TAGGED FOR RELEASE ***

	IMPLEMENTATION OF TIP#404.

Changes to changes.

8113
8114
8115
8116
8117
8118
8119


8120
8121
8122
8123
8124
8125
8126
....
8524
8525
8526
8527
8528
8529
8530




Many revisions to better support a Cygwin environment (nijtmans)

Dropped support for OS X versions less than 10.4 (Tiger) (fellows)

--- Released 8.6b3, September 18, 2012 --- See ChangeLog for details ---



2012-09-20 (enhancement) full Unicode support (nijtmans)
=> dde 1.4.0

2012-09-20 (enhancement) update bundled zlib to 1.2.7 (nijtmans)

2012-10-03 (bug fix) exit panic on stacked std channel (griffin,porter)

................................................................................

2015-02-20 (bug)[32b615] Fix compiled [lreplace] (lreplace-4.[345]) (aspect)

2015-03-10 (enhancement) Revise OS X notifier for better Cocoa (walzer)
        *** POTENTIAL INCOMPATIBILITY ***

--- Released 8.6.4, March 12, 2015 --- http://core.tcl.tk/tcl/ for details










>
>







 







>
>
>
>
8113
8114
8115
8116
8117
8118
8119
8120
8121
8122
8123
8124
8125
8126
8127
8128
....
8526
8527
8528
8529
8530
8531
8532
8533
8534
8535
8536
Many revisions to better support a Cygwin environment (nijtmans)

Dropped support for OS X versions less than 10.4 (Tiger) (fellows)

--- Released 8.6b3, September 18, 2012 --- See ChangeLog for details ---

2012-09-19 (tip412) msgcat dynamic locale change (oehlmann)

2012-09-20 (enhancement) full Unicode support (nijtmans)
=> dde 1.4.0

2012-09-20 (enhancement) update bundled zlib to 1.2.7 (nijtmans)

2012-10-03 (bug fix) exit panic on stacked std channel (griffin,porter)

................................................................................

2015-02-20 (bug)[32b615] Fix compiled [lreplace] (lreplace-4.[345]) (aspect)

2015-03-10 (enhancement) Revise OS X notifier for better Cocoa (walzer)
        *** POTENTIAL INCOMPATIBILITY ***

--- Released 8.6.4, March 12, 2015 --- http://core.tcl.tk/tcl/ for details

2015-06-25 (TIP 412) msgcat dynamic locale change and package private locale
=> msgcat 1.6.0

Changes to doc/msgcat.n.

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
..
79
80
81
82
83
84
85












86
87
88
89
90
91
92
93
94
95







96
97
98
99
100
101
102
103
104
105
106












107
108
109

110
111
112
113
114
115
116
117
118
119
120





121
122
123
124
125
126
127
...
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171











172
173
174
175
176
177
178
...
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
...
369
370
371
372
373
374
375











































































































































































































376
377
378
379
380
381
382
383
384
385
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
msgcat \- Tcl message catalog
.SH SYNOPSIS
\fBpackage require Tcl 8.5\fR
.sp
\fBpackage require msgcat 1.5\fR
.sp
\fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR?
.sp
\fB::msgcat::mcmax ?\fIsrc-string src-string ...\fR?




.sp
\fB::msgcat::mclocale \fR?\fInewLocale\fR?
.sp
\fB::msgcat::mcpreferences\fR




.sp
\fB::msgcat::mcload \fIdirname\fR
.sp
\fB::msgcat::mcset \fIlocale src-string \fR?\fItranslate-string\fR?
.sp
\fB::msgcat::mcmset \fIlocale src-trans-list\fR
.sp
.VS "TIP 404"
\fB::msgcat::mcflset \fIsrc-string \fR?\fItranslate-string\fR?
.sp
\fB::msgcat::mcflmset \fIsrc-trans-list\fR
.VE "TIP 404"
.sp
\fB::msgcat::mcunknown \fIlocale src-string\fR ?\fIarg arg ...\fR?








.BE
.SH DESCRIPTION
.PP
The \fBmsgcat\fR package provides a set of functions
that can be used to manage multi-lingual user interfaces.
Text strings are defined in a
.QW "message catalog"
which is independent from the application, and
which can be edited or localized without modifying
the application source code.  New languages
or locales are provided by adding a new file to
the message catalog.
.PP
Use of the message catalog is optional by any application
or package, but is encouraged if the application or package
wishes to be enabled for multi-lingual applications.





.SH COMMANDS
.TP
\fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR?
.
Returns a translation of \fIsrc-string\fR according to the
user's current locale.  If additional arguments past \fIsrc-string\fR
are given, the \fBformat\fR command is used to substitute the
additional arguments in the translation of \fIsrc-string\fR.
.RS
.PP
\fB::msgcat::mc\fR will search the messages defined
in the current namespace for a translation of \fIsrc-string\fR; if
none is found, it will search in the parent of the current namespace,
................................................................................
.TP
\fB::msgcat::mcmax ?\fIsrc-string src-string ...\fR?
.
Given several source strings, \fB::msgcat::mcmax\fR returns the length
of the longest translated string.  This is useful when designing
localized GUIs, which may require that all buttons, for example, be a
fixed width (which will be the width of the widest button).












.TP
\fB::msgcat::mclocale \fR?\fInewLocale\fR?
.
This function sets the locale to \fInewLocale\fR.  If \fInewLocale\fR
is omitted, the current locale is returned, otherwise the current locale
is set to \fInewLocale\fR.  msgcat stores and compares the locale in a
case-insensitive manner, and returns locales in lowercase.
The initial locale is determined by the locale specified in
the user's environment.  See \fBLOCALE SPECIFICATION\fR
below for a description of the locale string format.







.TP
\fB::msgcat::mcpreferences\fR
.
Returns an ordered list of the locales preferred by
the user, based on the user's language specification.
The list is ordered from most specific to least
preference.  The list is derived from the current
locale set in msgcat by \fB::msgcat::mclocale\fR, and
cannot be set independently.  For example, if the
current locale is en_US_funky, then \fB::msgcat::mcpreferences\fR
returns \fB{en_US_funky en_US en {}}\fR.












.TP
\fB::msgcat::mcload \fIdirname\fR
.

Searches the specified directory for files that match
the language specifications returned by \fB::msgcat::mcpreferences\fR
(note that these are all lowercase), extended by the file extension
.QW .msg .
Each matching file is
read in order, assuming a UTF-8 encoding.  The file contents are
then evaluated as a Tcl script.  This means that Unicode characters
may be present in the message file either directly in their UTF-8
encoded form, or by use of the backslash-u quoting recognized by Tcl
evaluation.  The number of message files which matched the specification
and were loaded is returned.





.TP
\fB::msgcat::mcset \fIlocale src-string \fR?\fItranslate-string\fR?
.
Sets the translation for \fIsrc-string\fR to \fItranslate-string\fR
in the specified \fIlocale\fR and the current namespace.  If
\fItranslate-string\fR is not specified, \fIsrc-string\fR is used
for both.  The function returns \fItranslate-string\fR.
................................................................................
\fIsrc-trans-list\fR must have an even number of elements and is in
the form {\fIsrc-string translate-string\fR ?\fIsrc-string
translate-string ...\fR?} \fB::msgcat::mcmset\fR can be significantly
faster than multiple invocations of \fB::msgcat::mcset\fR. The function
returns the number of translations set.
.TP
\fB::msgcat::mcflset \fIsrc-string \fR?\fItranslate-string\fR?
.VS "TIP 404"
Sets the translation for \fIsrc-string\fR to \fItranslate-string\fR in the
current namespace for the locale implied by the name of the message catalog
being loaded via \fB::msgcat::mcload\fR.  If \fItranslate-string\fR is not
specified, \fIsrc-string\fR is used for both.  The function returns
\fItranslate-string\fR.
.VE "TIP 404"
.TP
\fB::msgcat::mcflmset \fIsrc-trans-list\fR
.VS "TIP 404"
Sets the translation for multiple source strings in \fIsrc-trans-list\fR in
the current namespace for the locale implied by the name of the message
catalog being loaded via \fB::msgcat::mcload\fR. \fIsrc-trans-list\fR must
have an even number of elements and is in the form {\fIsrc-string
translate-string\fR ?\fIsrc-string translate-string ...\fR?}
\fB::msgcat::mcflmset\fR can be significantly faster than multiple invocations
of \fB::msgcat::mcflset\fR. The function returns the number of translations set.
.VE "TIP 404"
.TP
\fB::msgcat::mcunknown \fIlocale src-string\fR ?\fIarg arg ...\fR?
.
This routine is called by \fB::msgcat::mc\fR in the case when
a translation for \fIsrc-string\fR is not defined in the
current locale.  The default action is to return
\fIsrc-string\fR passed by format if there are any arguments.  This
procedure can be redefined by the
application, for example to log error messages for each unknown
string.  The \fB::msgcat::mcunknown\fR procedure is invoked at the
same stack context as the call to \fB::msgcat::mc\fR.  The return value
of \fB::msgcat::mcunknown\fR is used as the return value for the call
to \fB::msgcat::mc\fR.  











.SH "LOCALE SPECIFICATION"
.PP
The locale is specified to \fBmsgcat\fR by a locale string
passed to \fB::msgcat::mclocale\fR.
The locale string consists of
a language code, an optional country code, and an optional
system-specific code, each separated by
................................................................................
.QW C .
.PP
When a locale is specified by the user, a
.QW "best match"
search is performed during string translation.  For example, if a user
specifies
en_GB_Funky, the locales
.QW en_GB_Funky ,
.QW en_GB ,
.QW en
and
.MT
(the empty string)
are searched in order until a matching translation
string is found.  If no translation string is available, then
\fB::msgcat::mcunknown\fR is called.
.SH "NAMESPACES AND MESSAGE CATALOGS"
.PP
Strings stored in the message catalog are stored relative
to the namespace from which they were added.  This allows
multiple packages to use the same strings without fear
of collisions with other packages.  It also allows the
source string to be shorter and less prone to typographical
................................................................................
formatting substitution is done directly.
.PP
.CS
\fBmsgcat::mc\fR {Produced %1$d at %2$s} $num $city
# ... where that key is mapped to one of the
# human-oriented versions by \fBmsgcat::mcset\fR
.CE











































































































































































































.SH CREDITS
.PP
The message catalog code was developed by Mark Harrison.
.SH "SEE ALSO"
format(n), scan(n), namespace(n), package(n)
.SH KEYWORDS
internationalization, i18n, localization, l10n, message, text, translation
.\" Local Variables:
.\" mode: nroff
.\" End:






|




>
>
>
>




>
>
>
>







<



<


>
>
>
>
>
>
>
>










|


|
|
|
>
>
>
>
>





|







 







>
>
>
>
>
>
>
>
>
>
>
>










>
>
>
>
>
>
>










|
>
>
>
>
>
>
>
>
>
>
>
>



>

|
|








>
>
>
>
>







 







<





<


<







<












|
>
>
>
>
>
>
>
>
>
>
>







 







|
|






|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>










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
..
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
...
190
191
192
193
194
195
196

197
198
199
200
201

202
203

204
205
206
207
208
209
210

211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
...
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
...
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
msgcat \- Tcl message catalog
.SH SYNOPSIS
\fBpackage require Tcl 8.5\fR
.sp
\fBpackage require msgcat 1.6\fR
.sp
\fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR?
.sp
\fB::msgcat::mcmax ?\fIsrc-string src-string ...\fR?
.sp
.VS "TIP 412"
\fB::msgcat::mcexists\fR ?\fB-exactnamespace\fR? ?\fB-exactlocale\fR? \fIsrc-string\fR
.VE "TIP 412"
.sp
\fB::msgcat::mclocale \fR?\fInewLocale\fR?
.sp
\fB::msgcat::mcpreferences\fR
.sp
.VS "TIP 412"
\fB::msgcat::mcloadedlocales subcommand\fR ?\fIlocale\fR?
.VE "TIP 412"
.sp
\fB::msgcat::mcload \fIdirname\fR
.sp
\fB::msgcat::mcset \fIlocale src-string \fR?\fItranslate-string\fR?
.sp
\fB::msgcat::mcmset \fIlocale src-trans-list\fR
.sp

\fB::msgcat::mcflset \fIsrc-string \fR?\fItranslate-string\fR?
.sp
\fB::msgcat::mcflmset \fIsrc-trans-list\fR

.sp
\fB::msgcat::mcunknown \fIlocale src-string\fR ?\fIarg arg ...\fR?
.sp
.VS "TIP 412"
\fB::msgcat::mcpackagelocale subcommand\fR ?\fIlocale\fR?
.sp
\fB::msgcat::mcpackageconfig subcommand\fR \fIoption\fR ?\fIvalue\fR?
.sp
\fB::msgcat::mcforgetpackage\fR
.VE "TIP 412"
.BE
.SH DESCRIPTION
.PP
The \fBmsgcat\fR package provides a set of functions
that can be used to manage multi-lingual user interfaces.
Text strings are defined in a
.QW "message catalog"
which is independent from the application, and
which can be edited or localized without modifying
the application source code.  New languages
or locales may be provided by adding a new file to
the message catalog.
.PP
\fBmsgcat\fR distinguises packages by its namespace.
Each package has its own message catalog and configuration settings in \fBmsgcat\fR.
.PP
A \fIlocale\fR is a specification string describing a user language like \fBde_ch\fR for Swiss German.
In \fBmsgcat\fR, there is a global locale initialized by the system locale of the current system.
Each package may decide to use the global locale or to use a package specific locale.
.PP
The global locale may be changed on demand, for example by a user initiated language change or within a multi user application like a web server.
.SH COMMANDS
.TP
\fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR?
.
Returns a translation of \fIsrc-string\fR according to the
current locale.  If additional arguments past \fIsrc-string\fR
are given, the \fBformat\fR command is used to substitute the
additional arguments in the translation of \fIsrc-string\fR.
.RS
.PP
\fB::msgcat::mc\fR will search the messages defined
in the current namespace for a translation of \fIsrc-string\fR; if
none is found, it will search in the parent of the current namespace,
................................................................................
.TP
\fB::msgcat::mcmax ?\fIsrc-string src-string ...\fR?
.
Given several source strings, \fB::msgcat::mcmax\fR returns the length
of the longest translated string.  This is useful when designing
localized GUIs, which may require that all buttons, for example, be a
fixed width (which will be the width of the widest button).
.TP
\fB::msgcat::mcexists\fR ?\fB-exactnamespace\fR? ?\fB-exactlocale\fR? \fIsrc-string\fR
.
.VS "TIP 412"
Return true, if there is a translation for the given \fIsrc-string\fR.
.PP
.RS
The search may be limited by the option \fB\-exactnamespace\fR to only check the current namespace and not any parent namespaces.
.PP
It may also be limited by the option \fB\-exactlocale\fR to only check the first prefered locale (e.g. first element returned by \fB::msgcat::mcpreferences\fR if global locale is used).
.RE
.VE "TIP 412"
.TP
\fB::msgcat::mclocale \fR?\fInewLocale\fR?
.
This function sets the locale to \fInewLocale\fR.  If \fInewLocale\fR
is omitted, the current locale is returned, otherwise the current locale
is set to \fInewLocale\fR.  msgcat stores and compares the locale in a
case-insensitive manner, and returns locales in lowercase.
The initial locale is determined by the locale specified in
the user's environment.  See \fBLOCALE SPECIFICATION\fR
below for a description of the locale string format.
.RS
.PP
.VS "TIP 412"
If the locale is set, the preference list of locales is evaluated.
Locales in this list are loaded now, if not jet loaded.
.VE "TIP 412"
.RE
.TP
\fB::msgcat::mcpreferences\fR
.
Returns an ordered list of the locales preferred by
the user, based on the user's language specification.
The list is ordered from most specific to least
preference.  The list is derived from the current
locale set in msgcat by \fB::msgcat::mclocale\fR, and
cannot be set independently.  For example, if the
current locale is en_US_funky, then \fB::msgcat::mcpreferences\fR
returns \fB{en_us_funky en_us en {}}\fR.
.TP
\fB::msgcat:mcloadedlocales subcommand\fR ?\fIlocale\fR?
.
This group of commands manage the list of loaded locales for packages not setting a package locale.
.PP
.RS
The subcommand \fBget\fR returns the list of currently loaded locales.
.PP
The subcommand \fBpresent\fR requires the argument \fIlocale\fR and returns true, if this locale is loaded.
.PP
The subcommand \fBclear\fR removes all locales and their data, which are not in the current preference list.
.RE
.TP
\fB::msgcat::mcload \fIdirname\fR
.
.VS "TIP 412"
Searches the specified directory for files that match
the language specifications returned by \fB::msgcat::mcloadedlocales get\fR
(or \fBmsgcat::mcpackagelocale preferences\fR if a package locale is set) (note that these are all lowercase), extended by the file extension
.QW .msg .
Each matching file is
read in order, assuming a UTF-8 encoding.  The file contents are
then evaluated as a Tcl script.  This means that Unicode characters
may be present in the message file either directly in their UTF-8
encoded form, or by use of the backslash-u quoting recognized by Tcl
evaluation.  The number of message files which matched the specification
and were loaded is returned.
.RS
.PP
In addition, the given folder is stored in the \fBmsgcat\fR package configuration option \fImcfolder\fR to eventually load message catalog files required by a locale change.
.VE "TIP 412"
.RE
.TP
\fB::msgcat::mcset \fIlocale src-string \fR?\fItranslate-string\fR?
.
Sets the translation for \fIsrc-string\fR to \fItranslate-string\fR
in the specified \fIlocale\fR and the current namespace.  If
\fItranslate-string\fR is not specified, \fIsrc-string\fR is used
for both.  The function returns \fItranslate-string\fR.
................................................................................
\fIsrc-trans-list\fR must have an even number of elements and is in
the form {\fIsrc-string translate-string\fR ?\fIsrc-string
translate-string ...\fR?} \fB::msgcat::mcmset\fR can be significantly
faster than multiple invocations of \fB::msgcat::mcset\fR. The function
returns the number of translations set.
.TP
\fB::msgcat::mcflset \fIsrc-string \fR?\fItranslate-string\fR?

Sets the translation for \fIsrc-string\fR to \fItranslate-string\fR in the
current namespace for the locale implied by the name of the message catalog
being loaded via \fB::msgcat::mcload\fR.  If \fItranslate-string\fR is not
specified, \fIsrc-string\fR is used for both.  The function returns
\fItranslate-string\fR.

.TP
\fB::msgcat::mcflmset \fIsrc-trans-list\fR

Sets the translation for multiple source strings in \fIsrc-trans-list\fR in
the current namespace for the locale implied by the name of the message
catalog being loaded via \fB::msgcat::mcload\fR. \fIsrc-trans-list\fR must
have an even number of elements and is in the form {\fIsrc-string
translate-string\fR ?\fIsrc-string translate-string ...\fR?}
\fB::msgcat::mcflmset\fR can be significantly faster than multiple invocations
of \fB::msgcat::mcflset\fR. The function returns the number of translations set.

.TP
\fB::msgcat::mcunknown \fIlocale src-string\fR ?\fIarg arg ...\fR?
.
This routine is called by \fB::msgcat::mc\fR in the case when
a translation for \fIsrc-string\fR is not defined in the
current locale.  The default action is to return
\fIsrc-string\fR passed by format if there are any arguments.  This
procedure can be redefined by the
application, for example to log error messages for each unknown
string.  The \fB::msgcat::mcunknown\fR procedure is invoked at the
same stack context as the call to \fB::msgcat::mc\fR.  The return value
of \fB::msgcat::mcunknown\fR is used as the return value for the call
to \fB::msgcat::mc\fR.
.VS "TIP 412"
.RS
.PP
Note that this routine is only called if the concerned package did not set a package locale unknown command name.
.RE
.TP
\fB::msgcat::mcforgetpackage\fR
.
The calling package clears all its state within the \fBmsgcat\fR package including all settings and translations.
.VE "TIP 412"
.PP
.SH "LOCALE SPECIFICATION"
.PP
The locale is specified to \fBmsgcat\fR by a locale string
passed to \fB::msgcat::mclocale\fR.
The locale string consists of
a language code, an optional country code, and an optional
system-specific code, each separated by
................................................................................
.QW C .
.PP
When a locale is specified by the user, a
.QW "best match"
search is performed during string translation.  For example, if a user
specifies
en_GB_Funky, the locales
.QW en_gb_funky ,
.QW en_gb ,
.QW en
and
.MT
(the empty string)
are searched in order until a matching translation
string is found.  If no translation string is available, then
the unknown handler is called.
.SH "NAMESPACES AND MESSAGE CATALOGS"
.PP
Strings stored in the message catalog are stored relative
to the namespace from which they were added.  This allows
multiple packages to use the same strings without fear
of collisions with other packages.  It also allows the
source string to be shorter and less prone to typographical
................................................................................
formatting substitution is done directly.
.PP
.CS
\fBmsgcat::mc\fR {Produced %1$d at %2$s} $num $city
# ... where that key is mapped to one of the
# human-oriented versions by \fBmsgcat::mcset\fR
.CE
.VS "TIP 412"
.SH Package private locale
.PP
A package using \fBmsgcat\fR may choose to use its own package private
locale and its own set of loaded locales, independent to the global
locale set by \fB::msgcat::mclocale\fR.
.PP
This allows a package to change its locale without causing any locales load or removal in other packages and not to invoke the global locale change callback (see below).
.PP
This action is controled by the following ensemble:
.TP
\fB::msgcat::mcpackagelocale set\fR ?\fIlocale\fR?
.
Set or change a package private locale.
The package private locale is set to the given \fIlocale\fR if the \fIlocale\fR is given.
If the option \fIlocale\fR is not given, the package is set to package private locale mode, but no locale is changed (e.g. if the global locale was valid for the package before, it is copied to the package private locale).
.PP
.RS
This command may cause the load of locales.
.RE
.TP
\fB::msgcat::mcpackagelocale get\fR
.
Return the package private locale or the global locale, if no package private locale is set.
.TP
\fB::msgcat::mcpackagelocale preferences\fR
.
Return the package private preferences or the global preferences,
if no package private locale is set.
.TP
\fB::msgcat::mcpackagelocale loaded\fR
.
Return the list of locales loaded for this package.
.TP
\fB::msgcat::mcpackagelocale isset\fR
.
Returns true, if a package private locale is set.
.TP
\fB::msgcat::mcpackagelocale unset\fR
.
Unset the package private locale and use the globale locale.
Load and remove locales to adjust the list of loaded locales for the
package to the global loaded locales list.
.TP
\fB::msgcat::mcpackagelocale present\fR \fIlocale\fR
.
Returns true, if the given locale is loaded for the package.
.TP
\fB::msgcat::mcpackagelocale clear\fR
.
Clear any loaded locales of the package not present in the package preferences.
.PP
.SH Changing package options
.PP
Each package using msgcat has a set of options within \fBmsgcat\fR.
The package options are described in the next sectionPackage options.
Each package option may be set or unset individually using the following ensemble:
.TP
\fB::msgcat::mcpackageconfig get\fR \fIoption\fR
.
Return the current value of the given \fIoption\fR.
This call returns an error if the option is not set for the package.
.TP
\fB::msgcat::mcpackageconfig isset\fR \fIoption\fR
.
Returns 1, if the given \fIoption\fR is set for the package, 0 otherwise.
.TP
\fB::msgcat::mcpackageconfig set\fR \fIoption\fR \fIvalue\fR
.
Set the given \fIoption\fR to the given \fIvalue\fR.
This may invoke additional actions in dependency of the \fIoption\fR.
The return value is 0 or the number of loaded packages for the option \fBmcfolder\fR.
.TP
\fB::msgcat::mcpackageconfig unset\fR \fIoption\fR
.
Unsets the given \fIoption\fR for the package.
No action is taken if the \fIoption\fR is not set for the package.
The empty string is returned.
.SS Package options
.PP
The following package options are available for each package:
.TP
\fBmcfolder\fR
.
This is the message folder of the package. This option is set by mcload and by the subcommand set. Both are identical and both return the number of loaded message catalog files.
.RS
.PP
Setting or changing this value will load all locales contained in the preferences valid for the package. This implies also to invoke any set loadcmd (see below).
.PP
Unsetting this value will disable message file load for the package.
.RE
.TP
\fBloadcmd\fR
.
This callback is invoked before a set of message catalog files are loaded for the package which has this property set.
.PP
.RS
This callback may be used to do any preparation work for message file load or to get the message data from another source like a data base. In this case, no message files are used (mcfolder is unset).
.PP
See section \fBcallback invocation\fR below.
The parameter list appended to this callback is the list of locales to load.
.PP
If this callback is changed, it is called with the preferences valid for the package.
.RE
.TP
\fBchangecmd\fR
.
This callback is invoked when a default local change was performed. Its purpose is to allow a package to update any dependency on the default locale like showing the GUI in another language.
.PP
.RS
See the callback invocation section below.
The parameter list appended to this callback is \fBmcpreferences\fR.
The registered callbacks are invoked in no particular order.
.RE
.TP
\fBunknowncmd\fR
.
Use a package locale mcunknown procedure instead of the standard version supplied by the msgcat package (msgcat::mcunknown).
.PP
.RS
The called procedure must return the formatted message which will finally be returned by msgcat::mc.
.PP
A generic unknown handler is used if set to the empty string. This consists in returning the key if no arguments are given. With given arguments, format is used to process the arguments.
.PP
See section \fBcallback invocation\fR below.
The appended arguments are identical to \fB::msgcat::mcunknown\fR.
.RE
.SS Callback invocation
A package may decide to register one or multiple callbacks, as described above.
.PP
Callbacks are invoked, if:
.PP
1. the callback command is set,
.PP
2. the command is not the empty string,
.PP
3. the registering namespace exists.
.PP
If a called routine fails with an error, the \fBbgerror\fR routine for the interpreter is invoked after command completion.
Only exception is the callback \fBunknowncmd\fR, where an error causes the invoking \fBmc\fR-command to fail with that error.
.PP
.SS Examples
Packages which display a GUI may update their widgets when the global locale changes.
To register to a callback, use:
.CS
namespace eval gui {
    msgcat::mcpackageconfig changecmd updateGUI

    proc updateGui args {
        puts "New locale is '[lindex $args 0]'."
    }
}
% msgcat::mclocale fr
fr
% New locale is 'fr'.
.CE
.PP
If locales (or additional locales) are contained in another source like a data base, a package may use the load callback and not mcload:
.CS
namespace eval db {
    msgcat::mcpackageconfig loadcmd loadMessages

    proc loadMessages args {
        foreach locale $args {
            if {[LocaleInDB $locale]} {
                msgcat::mcmset $locale [GetLocaleList $locale]
            }
        }
    }
}
.CE
.PP
The \fBclock\fR command implementation uses \fBmsgcat\fR with a package locale to implement the command line parameter \fB-locale\fR.
Here are some sketches of the implementation:
.PP
First, a package locale is initialized and the generic unknown function is desactivated:
.CS
msgcat::mcpackagelocale set
msgcat::mcpackageconfig unknowncmd ""
.CE
As an example, the user requires the week day in a certain locale as follows:
.CS
clock format clock seconds -format %A -locale fr
.CE
\fBclock\fR sets the package locale to \fBfr\fR and looks for the day name as follows:
.CS
msgcat::mcpackagelocale set $locale
return [lindex [msgcat::mc DAYS_OF_WEEK_FULL] $day]
### Returns "mercredi"
.CE
Within \fBclock\fR, some message-catalog items are heavy in computation and thus are dynamically cached using:
.CS
proc ::tcl::clock::LocalizeFormat { locale format } {
    set key FORMAT_$format
    if { [::msgcat::mcexists -exactlocale -exactnamespace $key] } {
        return [mc $key]
    }
    #...expensive computation of format clipped...
    mcset $locale $key $format
    return $format
}
.CE
.VE "TIP 412"
.SH CREDITS
.PP
The message catalog code was developed by Mark Harrison.
.SH "SEE ALSO"
format(n), scan(n), namespace(n), package(n)
.SH KEYWORDS
internationalization, i18n, localization, l10n, message, text, translation
.\" Local Variables:
.\" mode: nroff
.\" End:

Changes to library/clock.tcl.

15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
..
56
57
58
59
60
61
62


63
64
65
66
67
68
69
...
102
103
104
105
106
107
108




109
110
111
112
113
114
115
...
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
...
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
...
655
656
657
658
659
660
661

662
663
664
665
666
667
668
...
688
689
690
691
692
693
694

695
696
697
698
699
700
701
...
706
707
708
709
710
711
712

713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
....
1177
1178
1179
1180
1181
1182
1183

1184
1185
1186
1187
1188
1189
1190
....
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
....
1300
1301
1302
1303
1304
1305
1306

1307
1308
1309
1310
1311
1312
1313
....
1427
1428
1429
1430
1431
1432
1433

1434
1435
1436
1437
1438
1439
1440
....
2151
2152
2153
2154
2155
2156
2157

2158
2159
2160
2161
2162
2163
2164
....
2220
2221
2222
2223
2224
2225
2226

2227
2228
2229
2230
2231
2232
2233
....
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358


2359
2360
2361
2362
2363
2364
2365
....
2478
2479
2480
2481
2482
2483
2484

2485
2486
2487
2488
2489
2490
2491
....
2501
2502
2503
2504
2505
2506
2507
2508
2509

2510
2511
2512

2513
2514
2515
2516
2517
2518
2519
2520
2521
....
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
....
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
....
3897
3898
3899
3900
3901
3902
3903

3904
3905
3906
3907
3908
3909
3910

3911
3912
3913
3914
3915
3916
3917
....
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
....
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
....
4445
4446
4447
4448
4449
4450
4451

4452
4453
4454
4455
4456
4457
4458
....
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
....
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
#
#----------------------------------------------------------------------

# We must have message catalogs that support the root locale, and we need
# access to the Registry on Windows systems.

uplevel \#0 {
    package require msgcat 1.4
    if { $::tcl_platform(platform) eq {windows} } {
	if { [catch { package require registry 1.1 }] } {
	    namespace eval ::tcl::clock [list variable NoRegistry {}]
	}
    }
}

................................................................................
    namespace export seconds
    namespace export add

    # Import the message catalog commands that we use.

    namespace import ::msgcat::mcload
    namespace import ::msgcat::mclocale



}

#----------------------------------------------------------------------
#
# ::tcl::clock::Initialize --
#
................................................................................
	    {-9223372036854775808 0 0 UTC}
	}
	set TZData(:UTC) $TZData(:Etc/UTC)
	set TZData(:localtime) {}
    }
    InitTZData





    # Define the message catalog for the root locale.

    ::msgcat::mcmset {} {
	AM {am}
	BCE {B.C.E.}
	CE {C.E.}
	DATE_FORMAT {%m/%d/%Y}
................................................................................
	    lappend ZoneinfoPaths $path
	}
    }

    # Define the directories for time zone data and message catalogs.

    variable DataDir [file join $LibDir tzdata]
    variable MsgDir [file join $LibDir msgs]

    # Number of days in the months, in common years and leap years.

    variable DaysInRomanMonthInCommonYear \
	{ 31 28 31 30 31 30 31 31 30 31 30 31 }
    variable DaysInRomanMonthInLeapYear \
	{ 31 29 31 30 31 30 31 31 30 31 30 31 }
................................................................................

    variable LocaleNumeralCache {};	# Dictionary whose keys are locale
					# names and whose values are pairs
					# comprising regexes matching numerals
					# in the given locales and dictionaries
					# mapping the numerals to their numeric
					# values.
    variable McLoaded {};		# Dictionary whose keys are locales
					# in which [mcload] has been executed
					# and whose values are second-level
    					# dictionaries indexed by message
    					# name and giving message text.
    # variable CachedSystemTimeZone;    # If 'CachedSystemTimeZone' exists,
					# it contains the value of the
					# system time zone, as determined from
					# the environment.
    variable TimeZoneBad {};	        # Dictionary whose keys are time zone
    					# names and whose values are 1 if
					# the time zone is unknown and 0
................................................................................
#
# The 'clock format' command formats times of day for output.  Refer to the
# user documentation to see what it does.
#
#----------------------------------------------------------------------

proc ::tcl::clock::format { args } {

    variable FormatProc
    variable TZData

    lassign [ParseFormatArgs {*}$args] format locale timezone
    set locale [string tolower $locale]
    set clockval [lindex $args 0]

................................................................................
	set procName $FormatProc($procName)
    } else {
	set FormatProc($procName) \
	    [ParseClockFormatFormat $procName $format $locale]
    }

    return [$procName $clockval $timezone]

}

#----------------------------------------------------------------------
#
# ParseClockFormatFormat --
#
#	Builds and caches a procedure that formats a time value.
................................................................................
#
# Results:
#	Returns the name of the newly-built procedure.
#
#----------------------------------------------------------------------

proc ::tcl::clock::ParseClockFormatFormat {procName format locale} {

    if {[namespace which $procName] ne {}} {
	return $procName
    }

    # Map away the locale-dependent composite format groups

    EnterLocale $locale oldLocale

    # Change locale if a fresh locale has been given on the command line.

    try {
	return [ParseClockFormatFormat2 $format $locale $procName]
    } trap CLOCK {result opts} {
	dict unset opts -errorinfo
	return -options $opts $result
    } finally {
	# Restore the locale

	if { [info exists oldLocale] } {
	    mclocale $oldLocale
	}
    }
}

proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
    set didLocaleEra 0
    set didLocaleNumerals 0
    set preFormatCode \
................................................................................
#
# The 'clock format' command scans times of day on input.  Refer to the user
# documentation to see what it does.
#
#----------------------------------------------------------------------

proc ::tcl::clock::scan { args } {

    set format {}

    # Check the count of args

    if { [llength $args] < 1 || [llength $args] % 2 != 1 } {
	set cmdName "clock scan"
	return -code error \
................................................................................

	}
	return [FreeScan $string $base $timezone $locale]
    }

    # Change locale if a fresh locale has been given on the command line.

    EnterLocale $locale oldLocale

    try {
	# Map away the locale-dependent composite format groups

	set scanner [ParseClockScanFormat $format $locale]
	return [$scanner $string $base $timezone]
    } trap CLOCK {result opts} {
	# Conceal location of generation of expected errors

	dict unset opts -errorinfo
	return -options $opts $result
    } finally {
	# Restore the locale

	if { [info exists oldLocale] } {
	    mclocale $oldLocale
	}
    }
}

#----------------------------------------------------------------------
#
# FreeScan --
#
................................................................................
# Results:
#	Returns the date and time extracted from the string in seconds from
#	the epoch
#
#----------------------------------------------------------------------

proc ::tcl::clock::FreeScan { string base timezone locale } {

    variable TZData

    # Get the data for time changes in the given zone

    try {
	SetupTimeZone $timezone
    } on error {retval opts} {
................................................................................
	    + ( 86400 * wide([dict get $date2 julianDay]) )
	    + [dict get $date secondOfDay]
	}]
	dict set date2 tzName $timezone
	set date2 [ConvertLocalToUTC $date2[set date2 {}] $TZData($timezone) \
		       2361222]
	set seconds [dict get $date2 seconds]

    }

    # Do relative month

    if { [llength $parseOrdinalMonth] > 0 } {
	lassign $parseOrdinalMonth monthOrdinal monthNumber
	if { $monthOrdinal > 0 } {
................................................................................
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::MakeUniquePrefixRegexp { successors
					  uniquePrefixMapping
					  prefixString } {

    # Get the characters that may follow the current prefix string

    set schars [lsort -ascii [dict keys [dict get $successors $prefixString]]]
    if { [llength $schars] == 0 } {
	return {}
    }

................................................................................
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::MakeParseCodeFromFields { dateFields parseActions } {

    set currPrio 999
    set currFieldPos [list]
    set currCodeBurst {
	error "in ::tcl::clock::MakeParseCodeFromFields: can't happen"
    }

    foreach { fieldSet prio parseAction } $parseActions {
................................................................................
#
# EnterLocale --
#
#	Switch [mclocale] to a given locale if necessary
#
# Parameters:
#	locale -- Desired locale
#	oldLocaleVar -- Name of a variable in caller's scope that
#		        tracks the previous locale name.
#
# Results:
#	Returns the locale that was previously current.
#
# Side effects:
#	Does [mclocale].  If necessary, uses [mcload] to load the designated
#	locale's files, and tracks that it has done so in the 'McLoaded'
#	variable.
#
#----------------------------------------------------------------------

proc ::tcl::clock::EnterLocale { locale oldLocaleVar } {
    upvar 1 $oldLocaleVar oldLocale

    variable MsgDir
    variable McLoaded

    set oldLocale [mclocale]
    if { $locale eq {system} } {
	if { $::tcl_platform(platform) ne {windows} } {
	    # On a non-windows platform, the 'system' locale is the same as
	    # the 'current' locale

	    set locale current
	} else {
	    # On a windows platform, the 'system' locale is adapted from the
	    # 'current' locale by applying the date and time formats from the
	    # Control Panel.  First, load the 'current' locale if it's not yet
	    # loaded

	    if {![dict exists $McLoaded $oldLocale] } {
		mcload $MsgDir
		dict set McLoaded $oldLocale {}
	    }

	    # Make a new locale string for the system locale, and get the
	    # Control Panel information

	    set locale ${oldLocale}_windows
	    if { ![dict exists $McLoaded $locale] } {
		LoadWindowsDateTimeFormats $locale
		dict set McLoaded $locale {}
	    }
	}
    }
    if { $locale eq {current}} {
	set locale $oldLocale
	unset oldLocale
    } elseif { $locale eq $oldLocale } {
	unset oldLocale
    } else {
	mclocale $locale
    }
    if { ![dict exists $McLoaded $locale] } {
	mcload $MsgDir
	dict set McLoaded $locale {}
    }


}

#----------------------------------------------------------------------
#
# LoadWindowsDateTimeFormats --
#
#	Load the date/time formats from the Control Panel in Windows and
................................................................................
	::msgcat::mcset $locale DATE_TIME_FORMAT "$datefmt $timefmt"
    }
    catch {
	::msgcat::mcset $locale LOCALE_DATE_TIME_FORMAT "$ldatefmt $timefmt"
    }

    return

}

#----------------------------------------------------------------------
#
# LocalizeFormat --
#
#	Map away locale-dependent format groups in a clock format.
................................................................................
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::LocalizeFormat { locale format } {
    variable McLoaded


    if { [dict exists $McLoaded $locale FORMAT $format] } {
	return [dict get $McLoaded $locale FORMAT $format]
    }

    set inFormat $format

    # Handle locale-dependent format groups by mapping them out of the format
    # string.  Note that the order of the [string map] operations is
    # significant because later formats can refer to later ones; for example
    # %c can refer to %X, which in turn can refer to %T.

    set list {
	%% %%
................................................................................
    lappend list %EX [string map $list [mc LOCALE_TIME_FORMAT]]
    lappend list %x  [string map $list [mc DATE_FORMAT]]
    lappend list %Ex [string map $list [mc LOCALE_DATE_FORMAT]]
    lappend list %c  [string map $list [mc DATE_TIME_FORMAT]]
    lappend list %Ec [string map $list [mc LOCALE_DATE_TIME_FORMAT]]
    set format [string map $list $format]

    dict set McLoaded $locale FORMAT $inFormat $format
    return $format
}

#----------------------------------------------------------------------
#
# FormatNumericTimeZone --
#
................................................................................
		    LoadZoneinfoFile [string range $timezone 1 end]
		}]
	    } then {
		return -code error \
		    -errorcode [list CLOCK badTimeZone $timezone] \
		    "time zone \"$timezone\" not found"
	    }

	} elseif { ![catch {ParsePosixTimeZone $timezone} tzfields] } {
	    # This looks like a POSIX time zone - try to process it

	    if { [catch {ProcessPosixTimeZone $tzfields} data opts] } {
		if { [lindex [dict get $opts -errorcode] 0] eq {CLOCK} } {
		    dict unset opts -errorinfo
		}
................................................................................
# Results:
#	Returns the transition time as a count of seconds from the epoch.  The
#	time is relative to the wall clock, not UTC.
#
#----------------------------------------------------------------------

proc ::tcl::clock::DeterminePosixDSTTime { z bound y } {

    variable FEB_28

    # Determine the start or end day of DST

    set date [dict create era CE year $y]
    set doy [dict get $z ${bound}DayOfYear]
    if { $doy ne {} } {

	# Time was specified as a day of the year

	if { [dict get $z ${bound}J] ne {}
	     && [IsGregorianLeapYear $y]
	     && ( $doy > $FEB_28 ) } {
	    incr doy
	}
................................................................................
    }
    if { ![string is boolean -strict $gmt] } {
	return -code error "expected boolean value but got \"$gmt\""
    } elseif { $gmt } {
	set timezone :GMT
    }

    EnterLocale $locale oldLocale

    set changeover [mc GREGORIAN_CHANGE_DATE]

    if {[catch {SetupTimeZone $timezone} retval opts]} {
	dict unset opts -errorinfo
	return -options $opts $retval
    }
................................................................................
	    }
	}
	return $clockval
    } trap CLOCK {result opts} {
	# Conceal the innards of [clock] when it's an expected error
	dict unset opts -errorinfo
	return -options $opts $result
    } finally {
	# Restore the locale

	if { [info exists oldLocale] } {
	    mclocale $oldLocale
	}
    }
}

#----------------------------------------------------------------------
#
# AddMonths --
#
................................................................................
	+ ( 86400 * wide([dict get $date julianDay]) )
	+ [dict get $date secondOfDay]
    }]
    set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) \
		 $changeover]

    return [dict get $date seconds]

}

#----------------------------------------------------------------------
#
# AddDays --
#
#	Add a given number of days to a given clock value in a given time
................................................................................
	+ ( 86400 * wide([dict get $date julianDay]) )
	+ [dict get $date secondOfDay]
    }]
    set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) \
		  $changeover]

    return [dict get $date seconds]
}

#----------------------------------------------------------------------
#
# mc --
#
#	Wrapper around ::msgcat::mc that caches the result according to the
#	locale.
#
# Parameters:
#	Accepts the name of the message to retrieve.
#
# Results:
#	Returns the message text.
#
# Side effects:
#	Caches the message text.
#
# Notes:
#	Only the single-argument version of [mc] is supported.
#
#----------------------------------------------------------------------

proc ::tcl::clock::mc { name } {
    variable McLoaded
    set Locale [mclocale]
    if { [dict exists $McLoaded $Locale $name] } {
	return [dict get $McLoaded $Locale $name]
    }
    set val [::msgcat::mc $name]
    dict set McLoaded $Locale $name $val
    return $val
}

#----------------------------------------------------------------------
#
# ClearCaches --
#
#	Clears all caches to reclaim the memory used in [clock]
................................................................................
#	Caches are cleared.
#
#----------------------------------------------------------------------

proc ::tcl::clock::ClearCaches {} {
    variable FormatProc
    variable LocaleNumeralCache
    variable McLoaded
    variable CachedSystemTimeZone
    variable TimeZoneBad

    foreach p [info procs [namespace current]::scanproc'*] {
	rename $p {}
    }
    foreach p [info procs [namespace current]::formatproc'*] {
	rename $p {}
    }

    catch {unset FormatProc}
    set LocaleNumeralCache {}
    set McLoaded {}
    catch {unset CachedSystemTimeZone}
    set TimeZoneBad {}
    InitTZData
}






|







 







>
>







 







>
>
>
>







 







<







 







<
<
<
<
<







 







>







 







>







 







>






|








<
<
<
<
<
<







 







>







 







|








<


<
<
<
<
<
<







 







>







 







>







 







>







 







>







 







<
<





|
<
<



|
<
<
<
<
<
<












|
<
<
<




|
|

<




|
<
<
<
<
<

<
<
<
<
>
>







 







>







 







<

>
|
<
|
>
|
|







 







|







 







<







 







>







>







 







|







 







<
<
<
<
<
<







 







>







 







|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







<












<




15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
..
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
...
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
...
251
252
253
254
255
256
257

258
259
260
261
262
263
264
...
624
625
626
627
628
629
630





631
632
633
634
635
636
637
...
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
...
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
...
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730






731
732
733
734
735
736
737
....
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
....
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273

1274
1275






1276
1277
1278
1279
1280
1281
1282
....
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
....
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
....
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
....
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
....
2288
2289
2290
2291
2292
2293
2294


2295
2296
2297
2298
2299
2300


2301
2302
2303
2304






2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317



2318
2319
2320
2321
2322
2323
2324

2325
2326
2327
2328
2329





2330




2331
2332
2333
2334
2335
2336
2337
2338
2339
....
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
....
2476
2477
2478
2479
2480
2481
2482

2483
2484
2485

2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
....
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
....
3104
3105
3106
3107
3108
3109
3110

3111
3112
3113
3114
3115
3116
3117
....
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
....
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
....
4343
4344
4345
4346
4347
4348
4349






4350
4351
4352
4353
4354
4355
4356
....
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
....
4466
4467
4468
4469
4470
4471
4472
4473































4474
4475
4476
4477
4478
4479
4480
....
4489
4490
4491
4492
4493
4494
4495

4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507

4508
4509
4510
4511
#
#----------------------------------------------------------------------

# We must have message catalogs that support the root locale, and we need
# access to the Registry on Windows systems.

uplevel \#0 {
    package require msgcat 1.6
    if { $::tcl_platform(platform) eq {windows} } {
	if { [catch { package require registry 1.1 }] } {
	    namespace eval ::tcl::clock [list variable NoRegistry {}]
	}
    }
}

................................................................................
    namespace export seconds
    namespace export add

    # Import the message catalog commands that we use.

    namespace import ::msgcat::mcload
    namespace import ::msgcat::mclocale
    namespace import ::msgcat::mc
    namespace import ::msgcat::mcpackagelocale

}

#----------------------------------------------------------------------
#
# ::tcl::clock::Initialize --
#
................................................................................
	    {-9223372036854775808 0 0 UTC}
	}
	set TZData(:UTC) $TZData(:Etc/UTC)
	set TZData(:localtime) {}
    }
    InitTZData

    mcpackagelocale set {}
    ::msgcat::mcpackageconfig set mcfolder [file join $LibDir msgs]
    ::msgcat::mcpackageconfig set unknowncmd ""

    # Define the message catalog for the root locale.

    ::msgcat::mcmset {} {
	AM {am}
	BCE {B.C.E.}
	CE {C.E.}
	DATE_FORMAT {%m/%d/%Y}
................................................................................
	    lappend ZoneinfoPaths $path
	}
    }

    # Define the directories for time zone data and message catalogs.

    variable DataDir [file join $LibDir tzdata]


    # Number of days in the months, in common years and leap years.

    variable DaysInRomanMonthInCommonYear \
	{ 31 28 31 30 31 30 31 31 30 31 30 31 }
    variable DaysInRomanMonthInLeapYear \
	{ 31 29 31 30 31 30 31 31 30 31 30 31 }
................................................................................

    variable LocaleNumeralCache {};	# Dictionary whose keys are locale
					# names and whose values are pairs
					# comprising regexes matching numerals
					# in the given locales and dictionaries
					# mapping the numerals to their numeric
					# values.





    # variable CachedSystemTimeZone;    # If 'CachedSystemTimeZone' exists,
					# it contains the value of the
					# system time zone, as determined from
					# the environment.
    variable TimeZoneBad {};	        # Dictionary whose keys are time zone
    					# names and whose values are 1 if
					# the time zone is unknown and 0
................................................................................
#
# The 'clock format' command formats times of day for output.  Refer to the
# user documentation to see what it does.
#
#----------------------------------------------------------------------

proc ::tcl::clock::format { args } {

    variable FormatProc
    variable TZData

    lassign [ParseFormatArgs {*}$args] format locale timezone
    set locale [string tolower $locale]
    set clockval [lindex $args 0]

................................................................................
	set procName $FormatProc($procName)
    } else {
	set FormatProc($procName) \
	    [ParseClockFormatFormat $procName $format $locale]
    }

    return [$procName $clockval $timezone]

}

#----------------------------------------------------------------------
#
# ParseClockFormatFormat --
#
#	Builds and caches a procedure that formats a time value.
................................................................................
#
# Results:
#	Returns the name of the newly-built procedure.
#
#----------------------------------------------------------------------

proc ::tcl::clock::ParseClockFormatFormat {procName format locale} {

    if {[namespace which $procName] ne {}} {
	return $procName
    }

    # Map away the locale-dependent composite format groups

    EnterLocale $locale

    # Change locale if a fresh locale has been given on the command line.

    try {
	return [ParseClockFormatFormat2 $format $locale $procName]
    } trap CLOCK {result opts} {
	dict unset opts -errorinfo
	return -options $opts $result






    }
}

proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
    set didLocaleEra 0
    set didLocaleNumerals 0
    set preFormatCode \
................................................................................
#
# The 'clock format' command scans times of day on input.  Refer to the user
# documentation to see what it does.
#
#----------------------------------------------------------------------

proc ::tcl::clock::scan { args } {

    set format {}

    # Check the count of args

    if { [llength $args] < 1 || [llength $args] % 2 != 1 } {
	set cmdName "clock scan"
	return -code error \
................................................................................

	}
	return [FreeScan $string $base $timezone $locale]
    }

    # Change locale if a fresh locale has been given on the command line.

    EnterLocale $locale

    try {
	# Map away the locale-dependent composite format groups

	set scanner [ParseClockScanFormat $format $locale]
	return [$scanner $string $base $timezone]
    } trap CLOCK {result opts} {
	# Conceal location of generation of expected errors

	dict unset opts -errorinfo
	return -options $opts $result






    }
}

#----------------------------------------------------------------------
#
# FreeScan --
#
................................................................................
# Results:
#	Returns the date and time extracted from the string in seconds from
#	the epoch
#
#----------------------------------------------------------------------

proc ::tcl::clock::FreeScan { string base timezone locale } {

    variable TZData

    # Get the data for time changes in the given zone

    try {
	SetupTimeZone $timezone
    } on error {retval opts} {
................................................................................
	    + ( 86400 * wide([dict get $date2 julianDay]) )
	    + [dict get $date secondOfDay]
	}]
	dict set date2 tzName $timezone
	set date2 [ConvertLocalToUTC $date2[set date2 {}] $TZData($timezone) \
		       2361222]
	set seconds [dict get $date2 seconds]

    }

    # Do relative month

    if { [llength $parseOrdinalMonth] > 0 } {
	lassign $parseOrdinalMonth monthOrdinal monthNumber
	if { $monthOrdinal > 0 } {
................................................................................
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::MakeUniquePrefixRegexp { successors
					  uniquePrefixMapping
					  prefixString } {

    # Get the characters that may follow the current prefix string

    set schars [lsort -ascii [dict keys [dict get $successors $prefixString]]]
    if { [llength $schars] == 0 } {
	return {}
    }

................................................................................
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::MakeParseCodeFromFields { dateFields parseActions } {

    set currPrio 999
    set currFieldPos [list]
    set currCodeBurst {
	error "in ::tcl::clock::MakeParseCodeFromFields: can't happen"
    }

    foreach { fieldSet prio parseAction } $parseActions {
................................................................................
#
# EnterLocale --
#
#	Switch [mclocale] to a given locale if necessary
#
# Parameters:
#	locale -- Desired locale


#
# Results:
#	Returns the locale that was previously current.
#
# Side effects:
#	Does [mclocale].  If necessary, loades the designated locale's files.


#
#----------------------------------------------------------------------

proc ::tcl::clock::EnterLocale { locale } {






    if { $locale eq {system} } {
	if { $::tcl_platform(platform) ne {windows} } {
	    # On a non-windows platform, the 'system' locale is the same as
	    # the 'current' locale

	    set locale current
	} else {
	    # On a windows platform, the 'system' locale is adapted from the
	    # 'current' locale by applying the date and time formats from the
	    # Control Panel.  First, load the 'current' locale if it's not yet
	    # loaded

	    mcpackagelocale set [mclocale]




	    # Make a new locale string for the system locale, and get the
	    # Control Panel information

	    set locale [mclocale]_windows
	    if { $locale ni [::msgcat::mcpackagelocale loaded] } {
		LoadWindowsDateTimeFormats $locale

	    }
	}
    }
    if { $locale eq {current}} {
	set locale [mclocale]





    }




    # Eventually load the locale
    mcpackagelocale set $locale
}

#----------------------------------------------------------------------
#
# LoadWindowsDateTimeFormats --
#
#	Load the date/time formats from the Control Panel in Windows and
................................................................................
	::msgcat::mcset $locale DATE_TIME_FORMAT "$datefmt $timefmt"
    }
    catch {
	::msgcat::mcset $locale LOCALE_DATE_TIME_FORMAT "$ldatefmt $timefmt"
    }

    return

}

#----------------------------------------------------------------------
#
# LocalizeFormat --
#
#	Map away locale-dependent format groups in a clock format.
................................................................................
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::LocalizeFormat { locale format } {


    # message catalog key to cache this format
    set key FORMAT_$format


    if { [::msgcat::mcexists -exactlocale -exactnamespace $key] } {
	return [mc $key]
    }
    # Handle locale-dependent format groups by mapping them out of the format
    # string.  Note that the order of the [string map] operations is
    # significant because later formats can refer to later ones; for example
    # %c can refer to %X, which in turn can refer to %T.

    set list {
	%% %%
................................................................................
    lappend list %EX [string map $list [mc LOCALE_TIME_FORMAT]]
    lappend list %x  [string map $list [mc DATE_FORMAT]]
    lappend list %Ex [string map $list [mc LOCALE_DATE_FORMAT]]
    lappend list %c  [string map $list [mc DATE_TIME_FORMAT]]
    lappend list %Ec [string map $list [mc LOCALE_DATE_TIME_FORMAT]]
    set format [string map $list $format]

    ::msgcat::mcset $locale $key $format
    return $format
}

#----------------------------------------------------------------------
#
# FormatNumericTimeZone --
#
................................................................................
		    LoadZoneinfoFile [string range $timezone 1 end]
		}]
	    } then {
		return -code error \
		    -errorcode [list CLOCK badTimeZone $timezone] \
		    "time zone \"$timezone\" not found"
	    }

	} elseif { ![catch {ParsePosixTimeZone $timezone} tzfields] } {
	    # This looks like a POSIX time zone - try to process it

	    if { [catch {ProcessPosixTimeZone $tzfields} data opts] } {
		if { [lindex [dict get $opts -errorcode] 0] eq {CLOCK} } {
		    dict unset opts -errorinfo
		}
................................................................................
# Results:
#	Returns the transition time as a count of seconds from the epoch.  The
#	time is relative to the wall clock, not UTC.
#
#----------------------------------------------------------------------

proc ::tcl::clock::DeterminePosixDSTTime { z bound y } {

    variable FEB_28

    # Determine the start or end day of DST

    set date [dict create era CE year $y]
    set doy [dict get $z ${bound}DayOfYear]
    if { $doy ne {} } {

	# Time was specified as a day of the year

	if { [dict get $z ${bound}J] ne {}
	     && [IsGregorianLeapYear $y]
	     && ( $doy > $FEB_28 ) } {
	    incr doy
	}
................................................................................
    }
    if { ![string is boolean -strict $gmt] } {
	return -code error "expected boolean value but got \"$gmt\""
    } elseif { $gmt } {
	set timezone :GMT
    }

    EnterLocale $locale

    set changeover [mc GREGORIAN_CHANGE_DATE]

    if {[catch {SetupTimeZone $timezone} retval opts]} {
	dict unset opts -errorinfo
	return -options $opts $retval
    }
................................................................................
	    }
	}
	return $clockval
    } trap CLOCK {result opts} {
	# Conceal the innards of [clock] when it's an expected error
	dict unset opts -errorinfo
	return -options $opts $result






    }
}

#----------------------------------------------------------------------
#
# AddMonths --
#
................................................................................
	+ ( 86400 * wide([dict get $date julianDay]) )
	+ [dict get $date secondOfDay]
    }]
    set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) \
		 $changeover]

    return [dict get $date seconds]

}

#----------------------------------------------------------------------
#
# AddDays --
#
#	Add a given number of days to a given clock value in a given time
................................................................................
	+ ( 86400 * wide([dict get $date julianDay]) )
	+ [dict get $date secondOfDay]
    }]
    set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) \
		  $changeover]

    return [dict get $date seconds]
































}

#----------------------------------------------------------------------
#
# ClearCaches --
#
#	Clears all caches to reclaim the memory used in [clock]
................................................................................
#	Caches are cleared.
#
#----------------------------------------------------------------------

proc ::tcl::clock::ClearCaches {} {
    variable FormatProc
    variable LocaleNumeralCache

    variable CachedSystemTimeZone
    variable TimeZoneBad

    foreach p [info procs [namespace current]::scanproc'*] {
	rename $p {}
    }
    foreach p [info procs [namespace current]::formatproc'*] {
	rename $p {}
    }

    catch {unset FormatProc}
    set LocaleNumeralCache {}

    catch {unset CachedSystemTimeZone}
    set TimeZoneBad {}
    InitTZData
}

Changes to library/msgcat/msgcat.tcl.

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
...
169
170
171
172
173
174
175


176
177
178
179
180
181
182
183
184
185




186
187
188
189
190
191
192
193

194

195
196
197






































198
199
200
201









202
203
204









205
206
207
208
209

210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242

243
244




245
246
247
248























249
250
251
252
253
254
255
256
257
258
259
...
263
264
265
266
267
268
269
270

































































































































































































































































































































































































271
272
273
274
275
276
277
278
279
280
281
282
















































283















284
285
286
287
288
289
290
291
292
293
294
295

296
297
298
299
300
301
302
303
304
305
306
307
308

























































309
310
311
312
313
314
315
...
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
...
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
...
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
...
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429

430
431
432
433
434
435
436
437
438
439
440
441
442
443
444























445
446
447
448
449
450
451
# 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-2000 by Ajuba Solutions.
# 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.

package require Tcl 8.5
# When the version number changes, be sure to update the pkgIndex.tcl file,
# and the installation directory in the Makefiles.
package provide msgcat 1.5.2

namespace eval msgcat {
    namespace export mc mcload mclocale mcmax mcmset mcpreferences mcset \
	    mcunknown mcflset mcflmset

    # Records the current locale as passed to mclocale
    variable Locale ""


    # Records the list of locales to search
    variable Loclist {}




    # Records the locale of the currently sourced message catalogue file
    variable FileLocale







    # Records the mapping between source strings and translated strings.  The
    # dict key is of the form "<locale> <namespace> <src>", where locale and
    # namespace should be themselves dict values and the value is
    # the translated string.
    variable Msgs [dict create]

    # Map of language codes used in Windows registry to those of ISO-639
    if {[info sharedlibextension] eq ".dll"} {
	variable WinRegToISO639 [dict create  {*}{
................................................................................
# msgcat::mc --
#
#	Find the translation for the given string based on the current
#	locale setting. Check the local namespace first, then look in each
#	parent namespace until the source is found.  If additional args are
#	specified, use the format command to work them into the traslated
#	string.


#
# Arguments:
#	src	The string to translate.
#	args	Args to pass to the format command
#
# Results:
#	Returns the translated string.  Propagates errors thrown by the
#	format command.

proc msgcat::mc {src args} {




    # Check for the src in each namespace starting from the local and
    # ending in the global.

    variable Msgs
    variable Loclist
    variable Locale

    set ns [uplevel 1 [list ::namespace current]]



    while {$ns != ""} {
	foreach loc $Loclist {
	    if {[dict exists $Msgs $loc $ns $src]} {






































		if {[llength $args] == 0} {
		    return [dict get $Msgs $loc $ns $src]
		} else {
		    return [format [dict get $Msgs $loc $ns $src] {*}$args]









		}
	    }
	}









	set ns [namespace parent $ns]
    }
    # we have not found the translation
    return [uplevel 1 [list [namespace origin mcunknown] \
	    $Locale $src {*}$args]]

}

# msgcat::mclocale --
#
#	Query or set the current locale.
#
# Arguments:
#	newLocale	(Optional) The new locale string. Locale strings
#			should be composed of one or more sublocale parts
#			separated by underscores (e.g. en_US).
#
# Results:
#	Returns the current locale.

proc msgcat::mclocale {args} {
    variable Loclist
    variable Locale
    set len [llength $args]

    if {$len > 1} {
	return -code error "wrong # args: should be\
		\"[lindex [info level 0] 0] ?newLocale?\""
    }

    if {$len == 1} {
	set newLocale [lindex $args 0]
	if {$newLocale ne [file tail $newLocale]} {
	    return -code error "invalid newLocale value \"$newLocale\":\
		    could be path to unsafe code."
	}
	set Locale [string tolower $newLocale]
	set Loclist {}
	set word ""

	foreach part [split $Locale _] {
	    set word [string trim "${word}_${part}" _]




	    if {$word ne [lindex $Loclist 0]} {
		set Loclist [linsert $Loclist 0 $word]
	    }
	}























	lappend Loclist {}
	set Locale [lindex $Loclist 0]
    }
    return $Locale
}

# msgcat::mcpreferences --
#
#	Fetch the list of locales used to look up strings, ordered from
#	most preferred to least preferred.
#
................................................................................
# Results:
#	Returns an ordered list of the locales preferred by the user.

proc msgcat::mcpreferences {} {
    variable Loclist
    return $Loclist
}


































































































































































































































































































































































































# msgcat::mcload --
#
#	Attempt to load message catalogs for each locale in the
#	preference list from the specified directory.
#
# Arguments:
#	langdir		The directory to search.
#
# Results:
#	Returns the number of message catalogs that were loaded.

proc msgcat::mcload {langdir} {
















































    variable FileLocale















    # Save the file locale if we are recursively called
    if {[info exists FileLocale]} {
	set nestedFileLocale $FileLocale
    }
    set x 0
    foreach p [mcpreferences] {
	if {$p eq {}} {
	    set p ROOT
	}
	set langfile [file join $langdir $p.msg]
	if {[file exists $langfile]} {
	    incr x

	    set FileLocale [string tolower [file tail [file rootname $langfile]]]
	    if {"root" eq $FileLocale} {
		set FileLocale ""
	    }
	    uplevel 1 [list ::source -encoding utf-8 $langfile]
	    unset FileLocale
	}
    }
    if {[info exists nestedFileLocale]} {
	set FileLocale $nestedFileLocale
    }
    return $x
}


























































# msgcat::mcset --
#
#	Set the translation for a given string in a specified locale.
#
# Arguments:
#	locale		The locale to use.
................................................................................
	set dest $src
    }

    set ns [uplevel 1 [list ::namespace current]]

    set locale [string tolower $locale]

    dict set Msgs $locale $ns $src $dest
    return $dest
}

# msgcat::mcflset --
#
#	Set the translation for a given string in the current file locale.
#
................................................................................
#	Returns the new locale.

proc msgcat::mcflset {src {dest ""}} {
    variable FileLocale
    variable Msgs

    if {![info exists FileLocale]} {
	return -code error \
	    "must only be used inside a message catalog loaded with ::msgcat::mcload"
    }
    if {[llength [info level 0]] == 2} { ;# dest not specified
	set dest $src
    }

    set ns [uplevel 1 [list ::namespace current]]
    dict set Msgs $FileLocale $ns $src $dest
    return $dest
}

# msgcat::mcmset --
#
#	Set the translation for multiple strings in a specified locale.
#
# Arguments:
................................................................................

proc msgcat::mcmset {locale pairs} {
    variable Msgs

    set length [llength $pairs]
    if {$length % 2} {
	return -code error "bad translation list:\
		 should be \"[lindex [info level 0] 0] locale {src dest ...}\""
    }

    set locale [string tolower $locale]
    set ns [uplevel 1 [list ::namespace current]]

    foreach {src dest} $pairs {
	dict set Msgs $locale $ns $src $dest
    }

    return [expr {$length / 2}]
}

# msgcat::mcflmset --
#
................................................................................
#	Returns the number of pairs processed

proc msgcat::mcflmset {pairs} {
    variable FileLocale
    variable Msgs

    if {![info exists FileLocale]} {
	return -code error \
	    "must only be used inside a message catalog loaded with ::msgcat::mcload"
    }
    set length [llength $pairs]
    if {$length % 2} {
	return -code error "bad translation list:\
		should be \"[lindex [info level 0] 0] locale {src dest ...}\""
    }

    set ns [uplevel 1 [list ::namespace current]]
    foreach {src dest} $pairs {
	dict set Msgs $FileLocale $ns $src $dest
    }
    return [expr {$length / 2}]
}

# msgcat::mcunknown --
#
#	This routine is called by msgcat::mc if a translation cannot

#	be found for a string.  This routine is intended to be replaced
#	by an application specific routine for error reporting
#	purposes.  The default behavior is to return the source string.
#	If additional args are specified, the format command will be used
#	to work them into the traslated string.
#
# Arguments:
#	locale		The current locale.
#	src		The string to be translated.
#	args		Args to pass to the format command
#
# Results:
#	Returns the translated value.

proc msgcat::mcunknown {locale src args} {























    if {[llength $args]} {
	return [format $src {*}$args]
    } else {
	return $src
    }
}






>









|


|
|
<
<
<
>



>
>
>




>
>
>
>
>
>

|







 







>
>










>
>
>
>





<


>

>
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
<
<
<
>
>
>
>
>
>
>
>
>
|
|
|
>
>
>
>
>
>
>
>
>


<
<
<
>












|



|








|




|
|
<
>
|
|
>
>
>
>
|
<
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
<

|







 








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>












>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>





|






>
|



|








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|







 







|
|

|
<
<
<
<
<
<







 







|






|







 







|
|

|
<
<
<
<
<
<
<
<
<
<





>
|













|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







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
...
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204

205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251



252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274



275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307

308
309
310
311
312
313
314
315

316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341

342
343
344
345
346
347
348
349
350
...
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
...
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
...
944
945
946
947
948
949
950
951
952
953
954






955
956
957
958
959
960
961
...
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
...
995
996
997
998
999
1000
1001
1002
1003
1004
1005










1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
# 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) 2010-2015 by Harald Oehlmann.
# Copyright (c) 1998-2000 by Ajuba Solutions.
# 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.

package require Tcl 8.5
# When the version number changes, be sure to update the pkgIndex.tcl file,
# and the installation directory in the Makefiles.
package provide msgcat 1.6.0

namespace eval msgcat {
    namespace export mc mcexists mcload mclocale mcmax mcmset mcpreferences mcset\
            mcunknown mcflset mcflmset mcloadedlocales mcforgetpackage\



	    mcpackageconfig mcpackagelocale

    # Records the list of locales to search
    variable Loclist {}

    # List of currently loaded locales
    variable LoadedLocales {}

    # Records the locale of the currently sourced message catalogue file
    variable FileLocale

    # Configuration values per Package (e.g. client namespace).
    # The dict key is of the form "<option> <namespace>" and the value is the
    # configuration option. A nonexisting key is an unset option.
    variable PackageConfig [dict create mcfolder {} loadcmd {} changecmd {}\
	    unknowncmd {} loadedlocales {} loclist {}]

    # Records the mapping between source strings and translated strings.  The
    # dict key is of the form "<namespace> <locale> <src>", where locale and
    # namespace should be themselves dict values and the value is
    # the translated string.
    variable Msgs [dict create]

    # Map of language codes used in Windows registry to those of ISO-639
    if {[info sharedlibextension] eq ".dll"} {
	variable WinRegToISO639 [dict create  {*}{
................................................................................
# msgcat::mc --
#
#	Find the translation for the given string based on the current
#	locale setting. Check the local namespace first, then look in each
#	parent namespace until the source is found.  If additional args are
#	specified, use the format command to work them into the traslated
#	string.
#	If no catalog item is found, mcunknown is called in the caller frame
#	and its result is returned.
#
# Arguments:
#	src	The string to translate.
#	args	Args to pass to the format command
#
# Results:
#	Returns the translated string.  Propagates errors thrown by the
#	format command.

proc msgcat::mc {src args} {
    # this may be replaced by:
    # return [mcget -namespace [uplevel 1 [list ::namespace current]] --\
    #	    $src {*}$args]

    # Check for the src in each namespace starting from the local and
    # ending in the global.

    variable Msgs
    variable Loclist


    set ns [uplevel 1 [list ::namespace current]]
    set loclist [PackagePreferences $ns]

    set nscur $ns
    while {$nscur != ""} {
	foreach loc $loclist {
	    if {[dict exists $Msgs $nscur $loc $src]} {
		return [DefaultUnknown "" [dict get $Msgs $nscur $loc $src]\
			{*}$args]
	    }
	}
	set nscur [namespace parent $nscur]
    }
    # call package local or default unknown command
    set args [linsert $args 0 [lindex $loclist 0] $src]
    switch -exact -- [Invoke unknowncmd $args $ns result 1] {
	0 { return [uplevel 1 [linsert $args 0 [namespace origin mcunknown]]] }
	1 { return [DefaultUnknown {*}$args] }
	default { return $result }
    }
}

# msgcat::mcexists --
#
#	Check if a catalog item is set or if mc would invoke mcunknown.
#
# Arguments:
#	-exactnamespace		Only check the exact namespace and no
#				parent namespaces
#	-exactlocale		Only check the exact locale and not all members
#				of the preferences list
#	src			Message catalog key
#
# Results:
#	true if an adequate catalog key was found

proc msgcat::mcexists {args} {

    variable Msgs
    variable Loclist
    variable PackageConfig

    set ns [uplevel 1 [list ::namespace current]]
    set loclist [PackagePreferences $ns]

    while {[llength $args] != 1} {



	set args [lassign $args option]
	switch -glob -- $option {
	    -exactnamespace { set exactnamespace 1 }
	    -exactlocale { set loclist [lrange $loclist 0 0] }
	    -* { return -code error "unknown option \"$option\"" }
	    default {
		return -code error "wrong # args: should be\
			\"[lindex [info level 0] 0] ?-exactnamespace?\
			?-exactlocale? src\""
	    }
	}
    }
    set src [lindex $args 0]
    
    while {$ns ne ""} {
	foreach loc $loclist {
	    if {[dict exists $Msgs $ns $loc $src]} {
		return 1
	    }
	}
	if {[info exists exactnamespace]} {return 0}
	set ns [namespace parent $ns]
    }



    return 0
}

# msgcat::mclocale --
#
#	Query or set the current locale.
#
# Arguments:
#	newLocale	(Optional) The new locale string. Locale strings
#			should be composed of one or more sublocale parts
#			separated by underscores (e.g. en_US).
#
# Results:
#	Returns the normalized set locale.

proc msgcat::mclocale {args} {
    variable Loclist
    variable LoadedLocales
    set len [llength $args]

    if {$len > 1} {
	return -code error "wrong # args: should be\
		\"[lindex [info level 0] 0] ?newLocale?\""
    }

    if {$len == 1} {
	set newLocale [string tolower [lindex $args 0]]
	if {$newLocale ne [file tail $newLocale]} {
	    return -code error "invalid newLocale value \"$newLocale\":\
		    could be path to unsafe code."
	}
	if {[lindex $Loclist 0] ne $newLocale} {
	    set Loclist [GetPreferences $newLocale]

	    
	    # locale not loaded jet
	    LoadAll $Loclist
	    # Invoke callback
	    Invoke changecmd $Loclist
	}
    }
    return [lindex $Loclist 0]

}

# msgcat::GetPreferences --
#
#	Get list of locales from a locale.
#	The first element is always the lowercase locale.
#	Other elements have one component separated by "_" less.
#	Multiple "_" are seen as one separator: de__ch_spec de__ch de {}
#
# Arguments:
#	Locale.
#
# Results:
#	Locale list

proc msgcat::GetPreferences {locale} {
    set locale [string tolower $locale]
    set loclist [list $locale]
    while {-1 !=[set pos [string last "_" $locale]]} {
	set locale [string range $locale 0 $pos-1]
	if { "_" ne [string index $locale end] } {
	    lappend loclist $locale
	}
    }
    if {"" ne [lindex $loclist end]} {
	lappend loclist {}

    }
    return $loclist
}

# msgcat::mcpreferences --
#
#	Fetch the list of locales used to look up strings, ordered from
#	most preferred to least preferred.
#
................................................................................
# Results:
#	Returns an ordered list of the locales preferred by the user.

proc msgcat::mcpreferences {} {
    variable Loclist
    return $Loclist
}

# msgcat::mcloadedlocales --
#
#	Get or change the list of currently loaded default locales
#
#	The following subcommands are available:
#	loaded
#	    Get the current list of loaded locales
#	clear
#	    Remove all loaded locales not present in mcpreferences.
#
# Arguments:
#	subcommand		One of loaded or clear
#
# Results:
#	Empty string, if not stated differently for the subcommand

proc msgcat::mcloadedlocales {subcommand} {
    variable Loclist
    variable LoadedLocales
    variable Msgs
    variable PackageConfig
    switch -exact -- $subcommand {
	clear {
	    # Remove all locales not contained in Loclist
	    # skip any packages with package locale
	    set LoadedLocales $Loclist
	    foreach ns [dict keys $Msgs] {
		if {![dict exists $PackageConfig loclist $ns]} {
		    foreach locale [dict keys [dict get $Msgs $ns]] {
			if {$locale ni $Loclist} {
			    dict unset Msgs $ns $locale
			}
		    }
		}
	    }
	}
	loaded { return $LoadedLocales }
	default {
	    return -code error "unknown subcommand \"$subcommand\": must be\
		    clear, or loaded"
	}
    }
    return
}

# msgcat::mcpackagelocale --
#
#	Get or change the package locale of the calling package.
#
#	The following subcommands are available:
#	set
#	    Set a package locale.
#	    This may load message catalog files and may clear message catalog
#	    items, if the former locale was the default locale.
#	    Returns the normalized set locale.
#	    The default locale is taken, if locale is not given.
#	get
#	    Get the locale valid for this package.
#	isset
#	    Returns true, if a package locale is set
#	unset
#	    Unset the package locale and activate the default locale.
#	    This loads message catalog file which where missing in the package
#	    locale.
#	preferences
#	    Return locale preference list valid for the package.
#	loaded
#	    Return loaded locale list valid for the current package.
#	clear
#	    If the current package has a package locale, remove all package
#	    locales not containes in package mcpreferences.
#	    It is an error to call this without a package locale set.
#
#	The subcommands get, preferences and loaded return the corresponding
#	default data, if no package locale is set.
#
# Arguments:
#	subcommand		see list above
#	locale			package locale (only set subcommand)
#
# Results:
#	Empty string, if not stated differently for the subcommand

proc msgcat::mcpackagelocale {subcommand {locale ""}} {
    # todo: implement using an ensemble
    variable Loclist
    variable LoadedLocales
    variable Msgs
    variable PackageConfig
    # Check option
    # check if required item is exactly provided
    if {[llength [info level 0]] == 2} {
	# locale not given
	unset locale
    } else {
	# locale given
	if {$subcommand in
		{"get" "isset" "unset" "preferences" "loaded" "clear"} } {
	    return -code error "wrong # args: should be\
		    \"[lrange [info level 0] 0 1]\""
	}
        set locale [string tolower $locale]
    }
    set ns [uplevel 1 {::namespace current}]
    
    switch -exact -- $subcommand {
	get { return [lindex [PackagePreferences $ns] 0] }
	preferences { return [PackagePreferences $ns] }
	loaded { return [PackageLocales $ns] }
	present { return [expr {$locale in [PackageLocales $ns]} ]}
	isset { return [dict exists $PackageConfig loclist $ns] }
	set { # set a package locale or add a package locale

	    # Copy the default locale if no package locale set so far
	    if {![dict exists $PackageConfig loclist $ns]} {
		dict set PackageConfig loclist $ns $Loclist
		dict set PackageConfig loadedlocales $ns $LoadedLocales
	    }

	    # Check if changed
	    set loclist [dict get $PackageConfig loclist $ns]
	    if {! [info exists locale] || $locale eq [lindex $loclist 0] } {
		return [lindex $loclist 0]
	    }

	    # Change loclist
	    set loclist [GetPreferences $locale]
	    set locale [lindex $loclist 0]
	    dict set PackageConfig loclist $ns $loclist

	    # load eventual missing locales
	    set loadedLocales [dict get $PackageConfig loadedlocales $ns]
	    if {$locale in $loadedLocales} { return $locale }
	    set loadLocales [ListComplement $loadedLocales $loclist]
	    dict set PackageConfig loadedlocales $ns\
		    [concat $loadedLocales $loadLocales]
	    Load $ns $loadLocales
	    return $locale
	}
	clear { # Remove all locales not contained in Loclist
	    if {![dict exists $PackageConfig loclist $ns]} {
		return -code error "clear only when package locale set"
	    }
	    set loclist [dict get $PackageConfig loclist $ns]
	    dict set PackageConfig loadedlocales $ns $loclist
	    if {[dict exists $Msgs $ns]} {
		foreach locale [dict keys [dict get $Msgs $ns]] {
		    if {$locale ni $loclist} {
			dict unset Msgs $ns $locale
		    }
		}
	    }
	}
	unset {	# unset package locale and restore default locales

	    if { ![dict exists $PackageConfig loclist $ns] } { return }

	    # unset package locale
	    set loadLocales [ListComplement\
		    [dict get $PackageConfig loadedlocales $ns] $LoadedLocales]
	    dict unset PackageConfig loadedlocales $ns
	    dict unset PackageConfig loclist $ns

	    # unset keys not in global loaded locales
	    if {[dict exists $Msgs $ns]} {
		foreach locale [dict keys [dict get $Msgs $ns]] {
		    if {$locale ni $LoadedLocales} {
			dict unset Msgs $ns $locale
		    }
		}
	    }

	    # Add missing locales
	    Load $ns $loadLocales
	}
	default {
	    return -code error "unknown subcommand \"$subcommand\": must be\
		    clear, get, isset, loaded, present, set, or unset"
	}
    }
    return
}

# msgcat::mcforgetpackage --
#
#	Remove any data of the calling package from msgcat
#

proc msgcat::mcforgetpackage {} {
    # todo: this may be implemented using an ensemble
    variable PackageConfig
    variable Msgs
    set ns [uplevel 1 {::namespace current}]
    # Remove MC items
    dict unset Msgs $ns
    # Remove config items
    foreach key [dict keys $PackageConfig] {
	dict unset PackageConfig $key $ns
    }
    return
}

# msgcat::mcpackageconfig --
#
#	Get or modify the per caller namespace (e.g. packages) config options.
#
#	Available subcommands are:
#
#	    get		get the current value or an error if not set.
#	    isset	return true, if the option is set
#	    set		set the value (see also distinct option).
#			Returns the number of loaded message files.
#	    unset	Clear option. return "".
#
#	Available options are:
#
#	mcfolder
#	    The message catalog folder of the package.
#	    This is automatically set by mcload.
#	    If the value is changed using the set subcommand, an evntual
#	    loadcmd is invoked and all message files of the package locale are
#	    loaded.
#
#	loadcmd
#	    The command gets executed before a message file would be
#	    sourced for this module.
#	    The command is invoked with the expanded locale list to load.
#	    The command is not invoked if the registering package namespace
#	    is not present.
#	    This callback might also be used as an alternative to message
#	    files.
#	    If the value is changed using the set subcommand, the callback is
#	    directly invoked with the current file locale list. No file load is
#	    executed.
#
#	changecmd
#	    The command is invoked, after an executed locale change.
#	    Appended argument is expanded mcpreferences.
#
#	unknowncmd
#	    Use a package locale mcunknown procedure instead the global one.
#	    The appended arguments are identical to mcunknown.
#	    A default unknown handler is used if set to the empty string.
#	    This consists in returning the key if no arguments are given.
#	    With given arguments, format is used to process the arguments.
#
# Arguments:
#	subcommand		Operation on the package
#	option			The package option to get or set.
#	?value?			Eventual value for the subcommand
#
# Results:
#	Depends on the subcommand and option and is described there

proc msgcat::mcpackageconfig {subcommand option {value ""}} {
    variable PackageConfig
    # get namespace
    set ns [uplevel 1 {::namespace current}]

    if {$option ni {"mcfolder" "loadcmd" "changecmd" "unknowncmd"}} {
	return -code error "bad option \"$option\": must be mcfolder, loadcmd,\
		changecmd, or unknowncmd"
    }

    # check if value argument is exactly provided
    if {[llength [info level 0]] == 4 } {
	# value provided
	if {$subcommand in {"get" "isset" "unset"}} {
	    return -code error "wrong # args: should be\
		    \"[lrange [info level 0] 0 2] value\""
	}
    } elseif {$subcommand eq "set"} {
        return -code error\
		"wrong # args: should be \"[lrange [info level 0] 0 2]\""
    }

    # Execute subcommands
    switch -exact -- $subcommand {
	get {	# Operation get return current value
	    if {![dict exists $PackageConfig $option $ns]} {
		return -code error "package option \"$option\" not set"
	    }
	    return [dict get $PackageConfig $option $ns]
	}
	isset {	return [dict exists $PackageConfig $option $ns] }
	unset {	dict unset PackageConfig $option $ns }
	set {	# Set option
	
	    if {$option eq "mcfolder"} {
		set value [file normalize $value]
	    }
	    # Check if changed
	    if { [dict exists $PackageConfig $option $ns]
		    && $value eq [dict get $PackageConfig $option $ns] } {
		return 0
	    }

	    # set new value
	    dict set PackageConfig $option $ns $value

	    # Reload pending message catalogs
	    switch -exact -- $option {
		mcfolder { return [Load $ns [PackageLocales $ns]] }
		loadcmd { return [Load $ns [PackageLocales $ns] 1] }
	    }
	    return 0
	}
	default {
	    return -code error "unknown subcommand \"$subcommand\":\
		    must be get, isset, set, or unset"
	}
    }
    return
}

# msgcat::PackagePreferences --
#
#	Return eventual present package preferences or the default list if not
#	present.
#
# Arguments:
#	ns		Package namespace
#
# Results:
#	locale list

proc msgcat::PackagePreferences {ns} {
    variable PackageConfig
    if {[dict exists $PackageConfig loclist $ns]} {
	return [dict get $PackageConfig loclist $ns]
    }
    variable Loclist
    return $Loclist
}

# msgcat::PackageLocales --
#
#	Return eventual present package locales or the default list if not
#	present.
#
# Arguments:
#	ns		Package namespace
#
# Results:
#	locale list

proc msgcat::PackageLocales {ns} {
    variable PackageConfig
    if {[dict exists $PackageConfig loadedlocales $ns]} {
	return [dict get $PackageConfig loadedlocales $ns]
    }
    variable LoadedLocales
    return $LoadedLocales
}

# msgcat::ListComplement --
#
#	Build the complement of two lists.
#	Return a list with all elements in list2 but not in list1.
#	Optionally return the intersection.
#
# Arguments:
#	list1		excluded list
#	list2		included list
#	inlistname	If not "", write in this variable the intersection list
#
# Results:
#	list with all elements in list2 but not in list1

proc msgcat::ListComplement {list1 list2 {inlistname ""}} {
    if {"" ne $inlistname} {
	upvar 1 $inlistname inlist
    }
    set inlist {}
    set outlist {}
    foreach item $list2 {
	if {$item in $list1} {
	    lappend inlist $item
	} else {
	    lappend outlist $item
	}
    }
    return $outlist
}

# msgcat::mcload --
#
#	Attempt to load message catalogs for each locale in the
#	preference list from the specified directory.
#
# Arguments:
#	langdir		The directory to search.
#
# Results:
#	Returns the number of message catalogs that were loaded.

proc msgcat::mcload {langdir} {
    return [uplevel 1 [list\
	    [namespace origin mcpackageconfig] set mcfolder $langdir]]
}

# msgcat::LoadAll --
#
#	Load a list of locales for all packages not having a package locale
#	list.
#
# Arguments:
#	langdir		The directory to search.
#
# Results:
#	Returns the number of message catalogs that were loaded.

proc msgcat::LoadAll {locales} {
    variable PackageConfig
    variable LoadedLocales
    if {0 == [llength $locales]} { return {} }
    # filter jet unloaded locales
    set locales [ListComplement $LoadedLocales $locales]
    if {0 == [llength $locales]} { return {} }
    lappend LoadedLocales {*}$locales
    
    set packages [lsort -unique [concat\
	    [dict keys [dict get $PackageConfig loadcmd]]\
	    [dict keys [dict get $PackageConfig mcfolder]]]]
    foreach ns $packages {
	if {! [dict exists $PackageConfig loclist $ns] } {
	    Load $ns $locales
	}
    }
    return $locales
}

# msgcat::Load --
#
#	Invoke message load callback and load message catalog files.
#
# Arguments:
#	ns		Namespace (equal package) to load the message catalog.
#	locales		List of locales to load.
#	callbackonly	true if only callback should be invoked
#
# Results:
#	Returns the number of message catalogs that were loaded.

proc msgcat::Load {ns locales {callbackonly 0}} {
    variable FileLocale
    variable PackageConfig
    variable LoadedLocals

    if {0 == [llength $locales]} { return 0 }

    # Invoke callback
    Invoke loadcmd $locales $ns
    
    if {$callbackonly || ![dict exists $PackageConfig mcfolder $ns]} {
	return 0
    }

    # Invoke file load
    set langdir [dict get $PackageConfig mcfolder $ns]
    
    # Save the file locale if we are recursively called
    if {[info exists FileLocale]} {
	set nestedFileLocale $FileLocale
    }
    set x 0
    foreach p $locales {
	if {$p eq {}} {
	    set p ROOT
	}
	set langfile [file join $langdir $p.msg]
	if {[file exists $langfile]} {
	    incr x
	    set FileLocale [string tolower\
		    [file tail [file rootname $langfile]]]
	    if {"root" eq $FileLocale} {
		set FileLocale ""
	    }
	    namespace inscope $ns [list ::source -encoding utf-8 $langfile]
	    unset FileLocale
	}
    }
    if {[info exists nestedFileLocale]} {
	set FileLocale $nestedFileLocale
    }
    return $x
}

# msgcat::Invoke --
#
#	Invoke a set of registered callbacks.
#	The callback is only invoked, if its registered namespace exists.
#
# Arguments:
#	index		Index into PackageConfig to get callback command
#	arglist		parameters to the callback invocation
#	ns		(Optional) package to call.
#			If not given or empty, check all registered packages.
#	resultname	Variable to save the callback result of the last called
#			callback to. May be set to "" to discard the result.
#	failerror (0)	Fail on error if true. Otherwise call bgerror.
#
# Results:
#	Possible values:
#	- 0: no valid command registered
#	- 1: registered command was the empty string
#	- 2: registered command called, resultname is set
#	- 3: registered command failed
#	If multiple commands are called, the maximum of all results is returned.

proc msgcat::Invoke {index arglist {ns ""} {resultname ""} {failerror 0}} {
    variable PackageConfig
    variable Config
    if {"" ne $resultname} {
	upvar 1 $resultname result
    }
    if {"" eq $ns} {
	set packageList [dict keys [dict get $PackageConfig $index]]
    } else {
	set packageList [list $ns]
    }
    set ret 0
    foreach ns $packageList {
	if {[dict exists $PackageConfig $index $ns] && [namespace exists $ns]} {
	    set cmd [dict get $PackageConfig $index $ns]
	    if {"" eq $cmd} {
		if {$ret == 0} {set ret 1}
	    } else {
		if {$failerror} {
		    set result [namespace inscope $ns $cmd {*}$arglist]
		    set ret 2
		} elseif {1 == [catch {
		    set result [namespace inscope $ns $cmd {*}$arglist]
		    if {$ret < 2} {set ret 2}
		} err derr]} {
		    after idle [concat [::interp bgerror ""]\
			    [list $err $derr]]
		    set ret 3
		}
	    }
	}
    }
    return $ret
}

# msgcat::mcset --
#
#	Set the translation for a given string in a specified locale.
#
# Arguments:
#	locale		The locale to use.
................................................................................
	set dest $src
    }

    set ns [uplevel 1 [list ::namespace current]]

    set locale [string tolower $locale]

    dict set Msgs $ns $locale $src $dest
    return $dest
}

# msgcat::mcflset --
#
#	Set the translation for a given string in the current file locale.
#
................................................................................
#	Returns the new locale.

proc msgcat::mcflset {src {dest ""}} {
    variable FileLocale
    variable Msgs

    if {![info exists FileLocale]} {
	return -code error "must only be used inside a message catalog loaded\
		with ::msgcat::mcload"
    }
    return [uplevel 1 [list [namespace origin mcset] $FileLocale $src $dest]]






}

# msgcat::mcmset --
#
#	Set the translation for multiple strings in a specified locale.
#
# Arguments:
................................................................................

proc msgcat::mcmset {locale pairs} {
    variable Msgs

    set length [llength $pairs]
    if {$length % 2} {
	return -code error "bad translation list:\
		should be \"[lindex [info level 0] 0] locale {src dest ...}\""
    }

    set locale [string tolower $locale]
    set ns [uplevel 1 [list ::namespace current]]

    foreach {src dest} $pairs {
	dict set Msgs $ns $locale $src $dest
    }

    return [expr {$length / 2}]
}

# msgcat::mcflmset --
#
................................................................................
#	Returns the number of pairs processed

proc msgcat::mcflmset {pairs} {
    variable FileLocale
    variable Msgs

    if {![info exists FileLocale]} {
	return -code error "must only be used inside a message catalog loaded\
		with ::msgcat::mcload"
    }
    return [uplevel 1 [list [namespace origin mcmset] $FileLocale $pairs]]










}

# msgcat::mcunknown --
#
#	This routine is called by msgcat::mc if a translation cannot
#	be found for a string and no unknowncmd is set for the current
#	package. This routine is intended to be replaced
#	by an application specific routine for error reporting
#	purposes.  The default behavior is to return the source string.
#	If additional args are specified, the format command will be used
#	to work them into the traslated string.
#
# Arguments:
#	locale		The current locale.
#	src		The string to be translated.
#	args		Args to pass to the format command
#
# Results:
#	Returns the translated value.

proc msgcat::mcunknown {args} {
    return [uplevel 1 [list [namespace origin DefaultUnknown] {*}$args]]
}

# msgcat::DefaultUnknown --
#
#	This routine is called by msgcat::mc if a translation cannot
#	be found for a string in the following circumstances:
#	- Default global handler, if mcunknown is not redefined.
#	- Per package handler, if the package sets unknowncmd to the empty
#	  string.
#	It returna the source string if the argument list is empty.
#	If additional args are specified, the format command will be used
#	to work them into the traslated string.
#
# Arguments:
#	locale		(unused) The current locale.
#	src		The string to be translated.
#	args		Args to pass to the format command
#
# Results:
#	Returns the translated value.

proc msgcat::DefaultUnknown {locale src args} {
    if {[llength $args]} {
	return [format $src {*}$args]
    } else {
	return $src
    }
}

Changes to library/msgcat/pkgIndex.tcl.

1
2
if {![package vsatisfies [package provide Tcl] 8.5]} {return}
package ifneeded msgcat 1.5.2 [list source [file join $dir msgcat.tcl]]
|
1
2
if {![package vsatisfies [package provide Tcl] 8.5]} {return}
package ifneeded msgcat 1.6.0 [list source [file join $dir msgcat.tcl]]

Changes to tests/msgcat.test.

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
...
408
409
410
411
412
413
414



415
416
417


418
419
420
421
422
423
424
425
426
427
428
429
430


431
432
433
434
435
436
437
438
439


440
441
442
443
444
445
446
...
492
493
494
495
496
497
498














499
500
501
502
503
504
505
...
653
654
655
656
657
658
659




































































































































































































































































































































































































660
661
662
663
664
# message catalogs for locales foo, foo_BAR, and foo_BAR_baz.

package require Tcl 8.5
if {[catch {package require tcltest 2}]} {
    puts stderr "Skipping tests in [info script].  tcltest 2 required."
    return
}
if {[catch {package require msgcat 1.5}]} {
    puts stderr "Skipping tests in [info script].  No msgcat 1.5 found to test."
    return
}

namespace eval ::msgcat::test {
    namespace import ::msgcat::*
    namespace import ::tcltest::test
    namespace import ::tcltest::cleanupTests
    namespace import ::tcltest::temporaryDirectory
    namespace import ::tcltest::make*
    namespace import ::tcltest::remove*

    # Tests msgcat-0.*: locale initialization



    proc PowerSet {l} {
	if {[llength $l] == 0} {return [list [list]]}
	set element [lindex $l 0]
	set rest [lrange $l 1 end]
	set result [list]
	foreach x [PowerSet $rest] {
	    lappend result [linsert $x 0 $element]
................................................................................
	}
	makeFile [list ::msgcat::mcset $loc abc abc-$loc] $msg.msg $msgdir
    }
    variable count 1
    foreach loc {foo foo_BAR foo_BAR_baz} {
	test msgcat-5.$count {mcload} -setup {
	    variable locale [mclocale]



	    mclocale $loc
	} -cleanup {
	    mclocale $locale


	} -body {
	    mcload $msgdir
	} -result [expr { $count+1 }]
	incr count
    }

    # Even though foo_BAR_notexist does not exist,
    # foo_BAR, foo and the root should be loaded.
	test msgcat-5.4 {mcload} -setup {
	    variable locale [mclocale]
	    mclocale foo_BAR_notexist
	} -cleanup {
	    mclocale $locale


	} -body {
	    mcload $msgdir
	} -result 3

	test msgcat-5.5 {mcload} -setup {
	    variable locale [mclocale]
	    mclocale no_FI_notexist
	} -cleanup {
	    mclocale $locale


	} -body {
	    mcload $msgdir
	} -result 1

	test msgcat-5.6 {mcload} -setup {
	    variable locale [mclocale]
	    mclocale foo
................................................................................
	} -cleanup {
	    mclocale $locale
	    rename ::msgcat::mcunknown {}
	    rename SavedMcunknown ::msgcat::mcunknown
	} -body {
	    mc def
	} -result unknown:no_fi_notexist:def















    foreach loc $locales {
	if { $loc eq {} } {
	    set msg ROOT
        } else {
	    set msg [string tolower $loc]
	}
................................................................................
	    return [mc k2][mc k3]
	} -result v2v3

    removeFile l2.msg $msgdir2
    removeDirectory msgdir2
    removeDirectory msgdir3





































































































































































































































































































































































































    cleanupTests
}
namespace delete ::msgcat::test
return







|
|













>
>







 







>
>
>



>
>













>
>









>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>





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
...
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
...
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
...
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
# message catalogs for locales foo, foo_BAR, and foo_BAR_baz.

package require Tcl 8.5
if {[catch {package require tcltest 2}]} {
    puts stderr "Skipping tests in [info script].  tcltest 2 required."
    return
}
if {[catch {package require msgcat 1.6}]} {
    puts stderr "Skipping tests in [info script].  No msgcat 1.6 found to test."
    return
}

namespace eval ::msgcat::test {
    namespace import ::msgcat::*
    namespace import ::tcltest::test
    namespace import ::tcltest::cleanupTests
    namespace import ::tcltest::temporaryDirectory
    namespace import ::tcltest::make*
    namespace import ::tcltest::remove*

    # Tests msgcat-0.*: locale initialization

    # Calculate set of all permutations of a list
    # PowerSet {1 2 3} -> {1 2 3} {2 3} {1 3} 3 {1 2} 2 1 {}
    proc PowerSet {l} {
	if {[llength $l] == 0} {return [list [list]]}
	set element [lindex $l 0]
	set rest [lrange $l 1 end]
	set result [list]
	foreach x [PowerSet $rest] {
	    lappend result [linsert $x 0 $element]
................................................................................
	}
	makeFile [list ::msgcat::mcset $loc abc abc-$loc] $msg.msg $msgdir
    }
    variable count 1
    foreach loc {foo foo_BAR foo_BAR_baz} {
	test msgcat-5.$count {mcload} -setup {
	    variable locale [mclocale]
	    ::msgcat::mclocale ""
	    ::msgcat::mcloadedlocales clear
	    ::msgcat::mcpackageconfig unset mcfolder 
	    mclocale $loc
	} -cleanup {
	    mclocale $locale
	    ::msgcat::mcloadedlocales clear
	    ::msgcat::mcpackageconfig unset mcfolder 
	} -body {
	    mcload $msgdir
	} -result [expr { $count+1 }]
	incr count
    }

    # Even though foo_BAR_notexist does not exist,
    # foo_BAR, foo and the root should be loaded.
	test msgcat-5.4 {mcload} -setup {
	    variable locale [mclocale]
	    mclocale foo_BAR_notexist
	} -cleanup {
	    mclocale $locale
	    mcloadedlocales clear
	    mcpackageconfig unset mcfolder 
	} -body {
	    mcload $msgdir
	} -result 3

	test msgcat-5.5 {mcload} -setup {
	    variable locale [mclocale]
	    mclocale no_FI_notexist
	} -cleanup {
	    mclocale $locale
	    mcloadedlocales clear
	    mcpackageconfig unset mcfolder 
	} -body {
	    mcload $msgdir
	} -result 1

	test msgcat-5.6 {mcload} -setup {
	    variable locale [mclocale]
	    mclocale foo
................................................................................
	} -cleanup {
	    mclocale $locale
	    rename ::msgcat::mcunknown {}
	    rename SavedMcunknown ::msgcat::mcunknown
	} -body {
	    mc def
	} -result unknown:no_fi_notexist:def

	test msgcat-5.11 {mcpackageconfig mcfolder} -setup {
	    variable locale [mclocale]
	    mclocale ""
	    mcloadedlocales clear
	    mcpackageconfig unset mcfolder
	} -cleanup {
	    mclocale $locale
	    mcloadedlocales clear
	    mcpackageconfig unset mcfolder 
	} -body {
	    mclocale foo
	    mcpackageconfig set mcfolder $msgdir
	} -result 2

    foreach loc $locales {
	if { $loc eq {} } {
	    set msg ROOT
        } else {
	    set msg [string tolower $loc]
	}
................................................................................
	    return [mc k2][mc k3]
	} -result v2v3

    removeFile l2.msg $msgdir2
    removeDirectory msgdir2
    removeDirectory msgdir3

    # Tests msgcat-9.*: [mcexists]

	test msgcat-9.1 {mcexists no parameter} -body {
	    mcexists
	} -returnCodes 1\
	-result {wrong # args: should be "mcexists ?-exactnamespace? ?-exactlocale? src"}
    
	test msgcat-9.2 {mcexists unknown option} -body {
	    mcexists -unknown src 
	} -returnCodes 1\
	-result {unknown option "-unknown"}
    
	test msgcat-9.3 {mcexists} -setup {
	    mcforgetpackage
	    variable locale [mclocale]
	    mclocale foo
	    mcset foo k1 v1
	} -cleanup {
	    mclocale $locale
	} -body {
	    list [mcexists k1] [mcexists k2]
	} -result {1 0}

	test msgcat-9.4 {mcexists descendent preference} -setup {
	    mcforgetpackage
	    variable locale [mclocale]
	    mclocale foo_bar
	    mcset foo k1 v1
	} -cleanup {
	    mclocale $locale
	} -body {
	    list [mcexists k1] [mcexists -exactlocale k1]
	} -result {1 0}
    
	test msgcat-9.5 {mcexists parent namespace} -setup {
	    mcforgetpackage
	    variable locale [mclocale]
	    mclocale foo_bar
	    mcset foo k1 v1
	} -cleanup {
	    mclocale $locale
	} -body {
	    namespace eval ::msgcat::test::sub {
		list [::msgcat::mcexists k1]\
			[::msgcat::mcexists -exactnamespace k1]
	    }
	} -result {1 0}
    
    # Tests msgcat-10.*: [mcloadedlocales]

	test msgcat-10.1 {mcloadedlocales no arg} -body {
	    mcloadedlocales
	} -returnCodes 1\
	-result {wrong # args: should be "mcloadedlocales subcommand"}
    
	test msgcat-10.2 {mcloadedlocales wrong subcommand} -body {
	    mcloadedlocales junk
	} -returnCodes 1\
	-result {unknown subcommand "junk": must be clear, or loaded}
    
	test msgcat-10.3 {mcloadedlocales loaded} -setup {
	    mcforgetpackage
	    variable locale [mclocale]
	    mclocale {}
	    mcloadedlocales clear
	} -cleanup {
	    mclocale $locale
	} -body {
	    mclocale foo_bar
	    # The result is position independent so sort
	    set resultlist [lsort [mcloadedlocales loaded]]
	} -result {{} foo foo_bar}
    
	test msgcat-10.4 {mcloadedlocales clear} -setup {
	    mcforgetpackage
	    variable locale [mclocale]
	    mclocale {}
	    mcloadedlocales clear
	} -cleanup {
	    mclocale $locale
	} -body {
	    mclocale foo
	    mcset foo k1 v1
	    set res [mcexists k1]
	    mclocale ""
	    mcloadedlocales clear
	    mclocale foo
	    lappend res [mcexists k1]
	} -result {1 0}

    # Tests msgcat-11.*: [mcforgetpackage]

	test msgcat-11.1 {mcforgetpackage translation} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	} -body {
	    mclocale foo
	    mcset foo k1 v1
	    set res [mcexists k1]
	    mcforgetpackage
	    lappend res [mcexists k1]
	} -result {1 0}

	test msgcat-11.2 {mcforgetpackage locale} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	} -body {
	    mclocale foo
	    mcpackagelocale set bar
	    set res [mcpackagelocale get]
	    mcforgetpackage
	    lappend res [mcpackagelocale get]
	} -result {bar foo}

	test msgcat-11.3 {mcforgetpackage options} -body {
	    mcpackageconfig set loadcmd ""
	    set res [mcpackageconfig isset loadcmd]
	    mcforgetpackage
	    lappend res [mcpackageconfig isset loadcmd]
	} -result {1 0}

    # Tests msgcat-12.*: [mcpackagelocale]

	test msgcat-12.1 {mcpackagelocale no subcommand} -body {
	    mcpackagelocale
	} -returnCodes 1\
	-result {wrong # args: should be "mcpackagelocale subcommand ?locale?"}

	test msgcat-12.2 {mclpackagelocale wrong subcommand} -body {
	    mcpackagelocale junk
	} -returnCodes 1\
	-result {unknown subcommand "junk": must be clear, get, isset, loaded, present, set, or unset}

	test msgcat-12.3 {mcpackagelocale set} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	    mcforgetpackage
	} -body {
	    mclocale foo
	    mcpackagelocale set bar
	    list [mcpackagelocale get] [mclocale]
	} -result {bar foo}

	test msgcat-12.4 {mcpackagelocale get} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	    mcforgetpackage
	} -body {
	    mclocale foo
	    set res [mcpackagelocale get]
	    mcpackagelocale set bar
	    lappend res [mcpackagelocale get]
	} -result {foo bar}

	test msgcat-12.5 {mcpackagelocale preferences} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	    mcforgetpackage
	} -body {
	    mclocale foo
	    set res [list [mcpackagelocale preferences]]
	    mcpackagelocale set bar
	    lappend res [mcpackagelocale preferences]
	} -result {{foo {}} {bar {}}}

	test msgcat-12.6 {mcpackagelocale loaded} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	    mcforgetpackage
	} -body {
	    mclocale ""
	    mcloadedlocales clear
	    mclocale foo
	    # The result is position independent so sort
	    set res [list [lsort [mcpackagelocale loaded]]]
	    mcpackagelocale set bar
	    lappend res [lsort [mcpackagelocale loaded]]
	} -result {{{} foo} {{} bar foo}}

	test msgcat-12.7 {mcpackagelocale isset} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	    mcforgetpackage
	} -body {
	    mclocale foo
	    set res [mcpackagelocale isset]
	    mcpackagelocale set bar
	    lappend res [mcpackagelocale isset]
	} -result {0 1}

	test msgcat-12.8 {mcpackagelocale unset} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	    mcforgetpackage
	} -body {
	    mcpackagelocale set bar
	    set res [mcpackagelocale isset]
	    mcpackagelocale unset
	    lappend res [mcpackagelocale isset]
	} -result {1 0}

	test msgcat-12.9 {mcpackagelocale present} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	    mcforgetpackage
	} -body {
	    mclocale ""
	    mcloadedlocales clear
	    mclocale foo
	    set res [mcpackagelocale present foo]
	    lappend res [mcpackagelocale present bar]
	    mcpackagelocale set bar
	    lappend res [mcpackagelocale present foo]\
		    [mcpackagelocale present bar]
	} -result {1 0 1 1}

	test msgcat-12.10 {mcpackagelocale clear} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	    mcforgetpackage
	} -body {
	    mclocale ""
	    mcloadedlocales clear
	    mclocale foo
	    mcpackagelocale set bar
	    mcpackagelocale clear
	    list [mcpackagelocale present foo] [mcpackagelocale present bar]
	} -result {0 1}

    # Tests msgcat-13.*: [mcpackageconfig subcmds]

	test msgcat-13.1 {mcpackageconfig no subcommand} -body {
	    mcpackageconfig
	} -returnCodes 1\
	-result {wrong # args: should be "mcpackageconfig subcommand option ?value?"}

	test msgcat-13.2 {mclpackageconfig wrong subcommand} -body {
	    mcpackageconfig junk mcfolder
	} -returnCodes 1\
	-result {unknown subcommand "junk": must be get, isset, set, or unset}

	test msgcat-13.3 {mclpackageconfig wrong option} -body {
	    mcpackageconfig get junk
	} -returnCodes 1\
	-result {bad option "junk": must be mcfolder, loadcmd, changecmd, or unknowncmd}

	test msgcat-13.4 {mcpackageconfig get} -setup {
	    mcforgetpackage
	} -cleanup {
	    mcforgetpackage
	} -body {
	    mcpackageconfig set loadcmd ""
	    mcpackageconfig get loadcmd
	} -result {}

	test msgcat-13.5 {mcpackageconfig (is/un)set} -setup {
	    mcforgetpackage
	} -cleanup {
	    mcforgetpackage
	} -body {
	    set res [mcpackageconfig isset loadcmd]
	    lappend res [mcpackageconfig set loadcmd ""]
	    lappend res [mcpackageconfig isset loadcmd]
	    mcpackageconfig unset loadcmd
	    lappend res [mcpackageconfig isset loadcmd]
	} -result {0 0 1 0}

    # option mcfolder is already tested with 5.11
    
    # Tests msgcat-14.*: callbacks: loadcmd, changecmd, unknowncmd
    
    # This routine is used as bgerror and by direct callback invocation
    proc callbackproc args {
	variable resultvariable
	set resultvariable $args
    }
    proc callbackfailproc args {
	return -code error fail
    }
    set bgerrorsaved [interp bgerror {}]
    interp bgerror {} [namespace code callbackproc]
    
	test msgcat-14.1 {invokation loadcmd} -setup {
	    mcforgetpackage
    	    mclocale $locale
	    mclocale ""
	    mcloadedlocales clear
	    set resultvariable ""
	} -cleanup {
	    mcforgetpackage
	} -body {
	    mcpackageconfig set loadcmd [namespace code callbackproc]
	    mclocale foo_bar
	    lsort $resultvariable
	} -result {foo foo_bar}

	test msgcat-14.2 {invokation failed in loadcmd} -setup {
	    mcforgetpackage
    	    mclocale $locale
	    mclocale ""
	    mcloadedlocales clear
	} -cleanup {
	    mcforgetpackage
	} -body {
	    mcpackageconfig set loadcmd [namespace code callbackfailproc]
	    mclocale foo_bar
	    # let the bgerror run
	    after 100 set [namespace current]::resultvariable timeout
	    vwait [namespace current]::resultvariable
	    lassign $resultvariable err errdict
	    list $err [dict get $errdict -code]
	} -result {fail 1}

	test msgcat-14.3 {invokation changecmd} -setup {
	    mcforgetpackage
    	    mclocale $locale
	    mclocale ""
	    set resultvariable ""
	} -cleanup {
	    mcforgetpackage
	} -body {
	    mcpackageconfig set changecmd [namespace code callbackproc]
	    mclocale foo_bar
	    set resultvariable
	} -result {foo_bar foo {}}

	test msgcat-14.4 {invokation unknowncmd} -setup {
	    mcforgetpackage
    	    mclocale $locale
	    mclocale ""
	    mcloadedlocales clear
	    set resultvariable ""
	} -cleanup {
	    mcforgetpackage
	} -body {
	    mcpackageconfig set unknowncmd [namespace code callbackproc]
	    mclocale foo_bar
	    mc k1 p1
	    set resultvariable
	} -result {foo_bar k1 p1}

	test msgcat-14.5 {disable global unknowncmd} -setup {
	    mcforgetpackage
    	    mclocale $locale
	    mclocale ""
	    mcloadedlocales clear
	    set resultvariable ""
	    rename ::msgcat::mcunknown SavedMcunknown
	    proc ::msgcat::mcunknown {dom s} {
		return unknown:$dom:$s
	    }
	} -cleanup {
	    mcforgetpackage
	    rename ::msgcat::mcunknown {}
	    rename SavedMcunknown ::msgcat::mcunknown
	} -body {
	    mcpackageconfig set unknowncmd ""
	    mclocale foo_bar
	    mc k1%s p1
	} -result {k1p1}

	test msgcat-14.6 {unknowncmd failing} -setup {
	    mcforgetpackage
    	    mclocale $locale
	    mclocale ""
	    mcloadedlocales clear
	    set resultvariable ""
	} -cleanup {
	    mcforgetpackage
	} -body {
	    mcpackageconfig set unknowncmd [namespace code callbackfailproc]
	    mclocale foo_bar
	    mc k1
	} -returnCodes 1\
	-result {fail}

    interp bgerror {} $bgerrorsaved

    cleanupTests
}
namespace delete ::msgcat::test
return

Changes to unix/Makefile.in.

843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
	@echo "Installing package http 2.8.9 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.9.tm;
	@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/";
	@for i in $(TOP_DIR)/library/opt/*.tcl ; \
	    do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \
	    done;
	@echo "Installing package msgcat 1.5.2 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.5.2.tm;
	@echo "Installing package tcltest 2.3.8 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.8.tm;

	@echo "Installing package platform 1.0.13 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.13.tm;
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform/shell-1.1.4.tm;






|
|







843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
	@echo "Installing package http 2.8.9 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.9.tm;
	@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/";
	@for i in $(TOP_DIR)/library/opt/*.tcl ; \
	    do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \
	    done;
	@echo "Installing package msgcat 1.6.0 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.6.0.tm;
	@echo "Installing package tcltest 2.3.8 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.8.tm;

	@echo "Installing package platform 1.0.13 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.13.tm;
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform/shell-1.1.4.tm;

Changes to win/Makefile.in.

646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
	@echo "Installing package http 2.8.9 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.9.tm;
	@echo "Installing library opt0.4 directory";
	@for j in $(ROOT_DIR)/library/opt/*.tcl; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	    done;
	@echo "Installing package msgcat 1.5.2 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.5.2.tm;
	@echo "Installing package tcltest 2.3.8 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.8.tm;
	@echo "Installing package platform 1.0.13 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.13.tm;
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/shell.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform/shell-1.1.4.tm;
	@echo "Installing encodings";






|
|







646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
	@echo "Installing package http 2.8.9 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.9.tm;
	@echo "Installing library opt0.4 directory";
	@for j in $(ROOT_DIR)/library/opt/*.tcl; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	    done;
	@echo "Installing package msgcat 1.6.0 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.6.0.tm;
	@echo "Installing package tcltest 2.3.8 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.8.tm;
	@echo "Installing package platform 1.0.13 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.13.tm;
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/shell.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform/shell-1.1.4.tm;
	@echo "Installing encodings";