File: Init.tcl

package info (click to toggle)
coccinella 0.96.20-9
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 13,184 kB
  • sloc: tcl: 124,744; xml: 206; makefile: 66; sh: 62
file content (813 lines) | stat: -rw-r--r-- 24,921 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
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
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
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
351
352
353
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
#  Init.tcl ---
#  
#      This file is part of The Coccinella application. 
#      It sets up the global 'this' array for useful things.
#      
#  Copyright (c) 2004-2008  Mats Bengtsson
#  
#   This program is free software: you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation, either version 3 of the License, or
#   (at your option) any later version.
#   
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#   
#   You should have received a copy of the GNU General Public License
#   along with this program.  If not, see <http://www.gnu.org/licenses/>.
#  
# $Id: Init.tcl,v 1.108 2008-08-19 07:56:57 matben Exp $

namespace eval ::Init {
    
    # Mutually exclusive.
    set ::config(prefs,sameDrive)  0
    set ::config(prefs,sameDir)    1
}

proc ::Init::SetThis {mainScript} {
    global  this auto_path tcl_platform prefs config
    
    # If we store the prefs file on a removable drive, use this folder name:
    #    F:\CoccinellaPrefs  etc.  
    set this(prefsDriverDir) "CoccinellaPrefs"
    
    # Collect paths in 'this' array.
    set path                    [file dirname $mainScript]
    set this(path)              $path
    set this(script)            $mainScript
    
    # Sub paths. Use relative source, prefs, or theme dirs. 
    # Keep generic path separator for theme engine.
    set this(emoticons)         iconsets/emoticons
    set this(images)            images
    set this(resources)         resources
    set this(sounds)            sounds
    set this(themes)            themes
    
    # Absolute paths.
    set this(componentPath)     [file join $path components]
    set this(docsPath)          [file join $path docs]
    set this(emoticonsPath)     [file join $path iconsets emoticons]
    set this(itemPath)          [file join $path items]
    set this(msgcatPath)        [file join $path msgs]
    set this(msgcatCompPath)    [file join $path msgs components]
    set this(msgcatPostPath)    [file join $path msgs post]
    set this(pluginsPath)       [file join $path plugins]
    set this(appletsPath)       [file join $path plugins applets]
    set this(resourcePath)      [file join $path resources]
    set this(postPrefsPath)     [file join $path resources post]
    set this(postPrefsFile)     [file join $path resources post prefs.rdb]
    set this(prePrefsPath)      [file join $path resources pre]
    set this(prePrefsFile)      [file join $path resources pre prefs.rdb]
    set this(themesPath)        [file join $path themes]
    set this(httpdRootPath)     $path
    set this(isAppWrapped)      0
    set this(appPath)           $path

    # 'appPath' points to folder which contains:
    #    Coccinella.tcl       if run from sources
    #    Coccinella*.exe      on Windows
    #    Coccinella*.bin      on Unix
    #    Coccinella*.app      on Mac OS X
    
    if {[info exists starkit::topdir]} {
	set this(appPath) [file dirname [info nameofexecutable]]
	set this(isAppWrapped) 1
    } elseif {$this(platform) eq "macosx"} {
	
	# If we have an application bundle we must get the .app folder.
	# bundle typically 'Coccinella-0.96.0.app'
	set psplit [file split $this(appPath)]
	set bundle [lsearch -glob -inline $psplit *.app]
	if {$bundle ne ""} {
	    set appBundle [lsearch -glob -inline \
	      [file split [info nameofexecutable]] *.app]
	    if {$appBundle eq $bundle} {
		set idx [lsearch -glob $psplit *.app]
		incr idx -1
		set this(appPath) [eval file join [lrange $psplit 0 $idx]]
		set this(isAppWrapped) 1
	    }
	}
    }
    
    # Path where preferences etc are stored.
    set this(prefsDefPath) [GetDefaultPrefsPath]
    set this(prefsPath)    $this(prefsDefPath)
    set this(prefsName)    "preferences.rdb"

    # Old prefs name (changed 0.96.3)
    switch -- $this(platform) {
	macosx {
	    set this(oldPrefsName) "Whiteboard Prefs"
	}
	unix {
	    set this(oldPrefsName) "whiteboard"
	}
	windows {
	    set this(oldPrefsName) "WBPREFS.TXT"
	}
    }

    if {$config(prefs,sameDrive)} {

	# Handle the situation where the app lives on a removable drive (USB stick).
	# If it lives on a removable drive, and if we find an existing prefs 
	# file there, then we should relate all prefs related paths to it.
	set this(prefsPathRemovable) 0
	if {[IsAppOnRemovableDrive]} {
	    set prefsPathDrive [GetAppDrivePrefsPath]
	    set prefFile [file join $prefsPathDrive $this(prefsName)]
	    set oldFile [file join $prefsPathDir $this(oldPrefsName)]
	    if {([file exists $prefFile] && [file writable $prefFile]) || \
	      ([file exists $oldFile] && [file writable $oldFile])} {
		set this(prefsPathRemovable) 1
		set this(prefsPath) $prefsPathDrive
	    }    
	}
    } elseif {$config(prefs,sameDir)} {
	
	# Search for the prefs file in the applicatons folder first.
	set this(prefsPathAppDir) 0
	set prefsPathDir [GetAppDirPrefsPath]
	set prefFile [file join $prefsPathDir $this(prefsName)]
	set oldFile [file join $prefsPathDir $this(oldPrefsName)]
	if {([file exists $prefFile] && [file writable $prefFile]) || \
	  ([file exists $oldFile] && [file writable $oldFile])} {
	    set this(prefsPathAppDir) 1
	    set this(prefsPath) $prefsPathDir
	}
    }
    
    # Import any old (pre 0.96.3) prefs file.
    set oldPrefs [file join $this(prefsPath) $this(oldPrefsName)]
    if {[file exists $oldPrefs]} {
	set newPrefs [file join $this(prefsPath) $this(prefsName)]
	file rename -force $oldPrefs $newPrefs
    }
    
    # Sets all paths that are dependent on this(prefsPath).
    SetPrefsPaths
    
    # Make sure all dirs exist.
    MakePrefsDirs

    # Need to rework this...
    if {0 && [info exists starkit::topdir]} {
	set this(httpdRootPath) $starkit::topdir
	set this(httpdRelPath)  \
	  [file join $::starkit::topdir lib app-Coccinella httpd]
    }
    set this(internalIPnum)  127.0.0.1
    set this(internalIPname) "localhost"
    
    # Set our IP number temporarily.
    set this(ipnum) $this(internalIPnum) 
    
    # Need a tmp directory, typically in a StarKit when QuickTime movies are opened.
    set MAX_INT 0x7FFFFFFF
    set hex [format {%x} [expr {int($MAX_INT*rand())}]]
    set tail coccinella[pid]-$hex
    set this(tmpPath) [file join [TempDir] $tail]
    if {![file isdirectory $this(tmpPath)]} {
	file mkdir $this(tmpPath)
    }
    
    # This is where the "Batteries Included" binaries go. Empty if non.
    if {$this(platform) eq "unix"} {
	set machine $tcl_platform(machine)
	if {[regexp {[2-9]86} $tcl_platform(machine)]} {
	    set machine "i686"
	} elseif {$tcl_platform(machine) eq "x86_64"} {
	    if {[info exists ::starkit::topdir]} {
	        set machine "i686"
	    } else {
	        set machine "x86_64"
	    }
	}
	set machineSpecPath [file join $tcl_platform(os) $machine]
    } elseif {$this(platform) eq "macosx"} {
	
	# We keep universal builds for 8.5 in 'i386'.
	if {[info tclversion] >= 8.5} {
	    set machineSpecPath i386
	} else {
	    set machineSpecPath $tcl_platform(machine)
	}
    } else {
	set machineSpecPath $tcl_platform(machine)
    }
    
    # Make cvs happy.
    regsub -all " " $machineSpecPath "" machineSpecPath
    
    set this(binLibPath) [file join $path bin library]
    set this(binPath)    [file join $path bin $this(platform) $machineSpecPath]
    if {[file exists $this(binPath)]} {
	set auto_path [concat [list $this(binPath)] $auto_path]
	set auto_path [concat [list $this(binLibPath)] $auto_path]
    } else {
	set this(binPath) {}
    }
    
    switch -- [tk windowingsystem] {
	"aqua"  { set this(modkey) Command }
	default { set this(modkey) Control }
    }
    
    # Find user name.
    set this(username) [GetUserName]
    
    # Write a pid file with our pid that gets deleted when quit.
    # This is a way to detect if we are running.
    set this(pidFile) [file join $this(prefsPath) coccinella.pid]
    set fd [open $this(pidFile) w]
    puts -nonewline $fd [pid]
    close $fd
    
    # Write a file to the prefs dir with our execution path.
    if {[info exists ::starkit::topdir]} {
	set exe [file nativename [info nameofexecutable]]
    } else {
	set exe "wish \"$mainScript\""
    }
    set this(execFile) [file join $this(prefsPath) launchCmd]
    set fd [open $this(execFile) w]
    puts -nonewline $fd $exe
    close $fd
}

# Init::GetDefaultPrefsPath --
# 
#       Finds the actual file path to our default prefs dir.

proc ::Init::GetDefaultPrefsPath {} {
    global  this
    
    # Path where preferences etc are stored.
    switch -- $this(platform) {
	macosx {
	    set prefsPath  \
	      [file join [file nativename ~/Library/Preferences] Coccinella]
	}    
	unix {
	    set prefsPath [file nativename ~/.coccinella]
	}
	windows {

	    # The default prefs dir is now obtained from the registry.
	    # If any old be sure to copy to new.
	    set appPath [GetWindowsAppPath]
	    set prefsPath [file join $appPath Coccinella]
	    if {![file isdirectory $prefsPath]} {
		set oldPath [GetWindowsAdhocPrefsPath]
		if {[file isdirectory $oldPath]} {
		    file copy -force -- $oldPath $appPath
		    file delete -force -- $oldPath
		}
	    }
	}
    }
    return $prefsPath
}

proc ::Init::GetWindowsAppPath {} {
    
    set appPath ""

    catch {
	package require registry
	set shellFoldersKey \
		 {HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders}
	set appPath [registry get $shellFoldersKey AppData]
	regsub -all {%([a-zA-Z]+)%} $appPath \$::env(\\1) appPath
	set appPath [subst -nobackslashes -nocommands $appPath]
	if {![file isdirectory $appPath]} {
	    file mkdir $appPath
	}
    } 
    return $appPath
}

proc ::Init::GetWindowsAdhocPrefsPath {} {

    set prefsPath ""

    foreach key {USERPROFILE APPDATA HOME HOMEPATH \
      ALLUSERSPROFILE CommonProgramFiles HOMEDRIVE} {
	if {[info exists ::env($key)] && [file writable $::env($key)]} {
	    set winPrefsDir $::env($key)
	    break
	}
    }
    if {![info exists winPrefsDir]} {
	set vols [lsort [file volumes]]
	set vols [lsearch -all -inline -glob -not $vols A:*]
	set vols [lsearch -all -inline -glob -not $vols B:*]
	
	# If none of the above are writable this is unlikely.
	if {[file writable [lindex $vols 0]]} {
	    set winPrefsDir [lindex $vols 0]
	} else {
	    if {[info exists starkit::topdir]} {
		set dir [file dirname [info nameofexecutable]]
	    } else {
		set dir [file dirname [file dirname $this(script)]]
	    }
	    if {[file writable $dir]} {
		set winPrefsDir $dir
	    }
	}
    }
    if {[info exists winPrefsDir]} {
	set prefsPath [file join $winPrefsDir Coccinella]
    }
    return $prefsPath
}

proc ::Init::IsAppOnRemovableDrive {} {
    global  this
    
    set ans 0

    if {$this(platform) eq "windows"} {
	set prefsDrive [string tolower [string index $this(prefsDefPath) 0]]
	set appDrive   [string tolower [string index $this(appPath) 0]]
	if {$prefsDrive ne $appDrive} {
	    set ans 1
	}
    } elseif {$this(platform) eq "macosx"} {
	
	# Try to see if different drives. Ad hoc.
	set lprefs [file split $this(prefsDefPath)]
	set lapp   [file split $this(appPath)]
	set prefs1 [lindex $lprefs 1]
	set app1   [lindex $lapp 1]
	if {($app1 ne $prefs1) && ($app1 eq "Volumes")} {
	    set ans 1
	}
    } elseif {$this(platform) eq "unix"} {
	# @@@ Don't know how to detect drives on unix in general.
    } 
    return $ans
}

# Init::GetAppDrivePrefsPath --
#
#       Gets the prefs path for nonstandard drive.
#       It doesn't check for its existence.
#       You MUST have 'IsAppOnRemovableDrive' for this to make sense.

proc ::Init::GetAppDrivePrefsPath {} {
    global  this
    
    set lapp [file split $this(appPath)]

    if {$this(platform) eq "windows"} {
	set path [file join [lindex $lapp 0] $this(prefsDriverDir)]
    } elseif {$this(platform) eq "macosx"} {
	set drive [lindex $lapp 2]
	set path [file join [lindex $lapp 0] [lindex $lapp 1] [lindex $lapp 2]  \
	  $this(prefsDriverDir)]
    } elseif {$this(platform) eq "unix"} {
	# @@@ Don't know how to detect drives on unix in general.
	set path ""
    } 
    return $path
}

#       One above this(appPath).

proc ::Init::GetAppDirPrefsPath {} {
    global  this
    if {$this(isAppWrapped)} {
	set path [file join $this(appPath) $this(prefsDriverDir)]
    } else {
	set psplit [file split $this(appPath)]
	set path [eval file join [lrange $psplit 0 end-1] $this(prefsDriverDir)]
    }
    return $path
}

# Init::SetPrefsPaths --
# 
#       Is supposed to set all standard paths that are dependent on 
#       this(prefsPath).

proc ::Init::SetPrefsPaths {} {
    global  this
    
    set path $this(prefsPath)
    
    set this(altItemPath)       [file join $path items]
    set this(altEmoticonsPath)  [file join $path $this(emoticons)]
    set this(altThemesPath)     [file join $path themes]
    set this(inboxFile)         [file join $path Inbox.tcl]
    set this(prefsAvatarPath)   [file join $path avatar]
    set this(myAvatarPath)      [file join $path avatar my]
    set this(cacheAvatarPath)   [file join $path avatar cache]
    set this(recentAvatarPath)  [file join $path avatar recent]
    set this(scriptsPath)       [file join $path scripts]
    set this(backgroundsPath)   [file join $path backgrounds]
    set this(certificatesPath)  [file join $path certificates]

    set pname $this(prefsName)

    switch -- $this(platform) {
	unix {
	    
	    # On a central installation need to have local dirs for write access.
	    set this(userPrefsFilePath) [file nativename [file join $path $pname]]
	    set this(inboxCanvasPath) [file nativename [file join $path canvases]]
	    set this(historyPath) [file nativename [file join $path history]]
	}
	macosx {
	    set this(userPrefsFilePath) [file join $path $pname]
	    set this(inboxCanvasPath) [file join $path Canvases]
	    set this(historyPath) [file join $path History]
	}
	windows {
	    set this(userPrefsFilePath) [file join $path $pname]
	    set this(inboxCanvasPath) [file join $path Canvases]
	    set this(historyPath) [file join $path History]
	}
    }
}

# Init::SetPrefsPathToDefault, SetPrefsPathToRemovable --
# 
#       Helpers to allow switching prefs location.

proc ::Init::SetPrefsPathToDefault {} {
    global  this
    
    set this(prefsPath) [GetDefaultPrefsPath]
    set this(prefsPathRemovable) 0
    set this(prefsPathAppDir) 0

    SetPrefsPaths
    MakePrefsDirs
}

proc ::Init::SetPrefsPathToRemovable {} {
    global  this
    
    set this(prefsPath) [GetAppDrivePrefsPath]
    set this(prefsPathRemovable) 1
    set this(prefsPathAppDir) 0
    
    SetPrefsPaths
    MakePrefsDirs
}

proc ::Init::SetPrefsPathToAppDir {} {
    global  this

    set this(prefsPath) [GetAppDirPrefsPath]
    set this(prefsPathAppDir) 1

    SetPrefsPaths
    MakePrefsDirs
}

proc ::Init::GetUserName {} {
    global  this
      
    # Find user name.
    if {[info exists ::env(USER)]} {
	set username $::env(USER)
    } elseif {[info exists ::env(LOGIN)]} {
	set username $::env(LOGIN)
    } elseif {[info exists ::env(USERNAME)]} {
	set username $::env(USERNAME)
    } elseif {[llength [set this(hostname) [info hostname]]]} {
	set username $this(hostname)
    } else {
	set username "Unknown"
    }
    return $username
}

proc ::Init::SetThisVersion {} {
    global  this
    
    # The application major and minor version numbers; should only be written to
    # default file, never read.
    set this(vers,major)    0
    set this(vers,minor)   96
    set this(vers,release)  20
    
    # NB: The 'minorRelease' number is only used for released versions and not
    #     in cvs or so called daily builds. cvs always have odd 'release'
    #     numbers and 'minorRelease' equal to 0. 
    #     A minor release has always a nonzero 'minorRelease' number and
    #     an even 'release' number one minus the cvs 'release' number.
    #     An example: if the cvs version id 0.96.5 we can create a series
    #     of minor releases 0.96.4.1, 0.96.4.2, 0.96.4.3, ...
    set this(vers,minorRelease) 0
    
    set this(vers,full) $this(vers,major).$this(vers,minor).$this(vers,release)
    if {$this(vers,minorRelease)} {
	append this(vers,full) .$this(vers,minorRelease)
    }
    
    # This is used only to track upgrades.
    set this(vers,previous) $this(vers,full)
}

proc ::Init::SetThisEmbedded {} {
    global  this
    
    # We may be embedded in another application, say an ActiveX component.
    # The TclControl ActiveX package defines the browser namespace.
    # So does the TclPlugin, at least version 2.0:
    # http://www.tcl.tk/man/plugin2.0/pluginDoc/plugin.htm
    if {[namespace exists ::browser]} {
	set this(embedded) 1
    } else {
	set this(embedded) 0
    }
}

proc ::Init::MakePrefsDirs {} {
    global  this tcl_platform
    
    foreach name {
	prefsPath
	inboxCanvasPath
	historyPath
	prefsAvatarPath
	myAvatarPath
	cacheAvatarPath
	recentAvatarPath
	altItemPath
	altEmoticonsPath
	altThemesPath
	scriptsPath
	backgroundsPath
    } {
	if {[file isfile $this($name)]} {
	    file delete -force $this($name)
	}
	if {![file isdirectory $this($name)]} {
	    file mkdir $this($name)
	}
    }	
    
    # Privacy!
    # Make sure other have absolutely no access to our prefs.
    # [Bug 243364] [NEW] umask needs to be set to 077 (?)
    if {$tcl_platform(platform) eq "unix"} {
	file attributes $this(prefsPath) -permissions 0700
    }
}

proc ::Init::SetAutoPath {} {
    global  auto_path this prefs
    
    # Hack on MacOSX to avoid all old installed packages.
    if {$this(platform) eq "macosx"} {
	set auto_path [lsearch -all -not -inline $auto_path "/System/Library/Tcl"]
	set auto_path [lsearch -all -not -inline $auto_path "/System/Library/Frameworks"]
	set auto_path [lsearch -all -not -inline $auto_path "/Network/Library/Tcl"]
	set auto_path [lsearch -all -not -inline $auto_path "/Network/Library/Frameworks"]
	set auto_path [lsearch -all -not -inline $auto_path "~/Library/Tcl"]
	set auto_path [lsearch -all -not -inline $auto_path "~/Library/Frameworks"]
    }
    
    # Add our lib and whiteboard directory to our search path.
    lappend auto_path [file join $this(path) lib]
    lappend auto_path [file join $this(path) whiteboard]

    # Add the contrib directory which has things like widgets etc. 
    lappend auto_path [file join $this(path) contrib]

    # Add the jabberlib directory which provides jabber support. 
    lappend auto_path [file join $this(path) jabberlib]
    
    # Add the jabber directory which provides client specific jabber stuffs. 
    lappend auto_path [file join $this(path) jabber]
    
    # Add the components directory since we may have packages used by components.
    lappend auto_path [file join $this(path) components]
    
    # Do we need TclXML. This is in its own app specific dir.
    # Perhaps there can be a conflict if there is already an TclXML
    # package installed in the standard 'auto_path'. Be sure to have it first!
    set auto_path [concat [list [file join $this(path) TclXML]] $auto_path]
}

proc ::Init::Msgcat {} {
    global  prefs this
    
    package require msgcat

    # The message catalog for language customization. Use 'en' as fallback.
    if {$prefs(messageLocale) eq ""} {
	if {[string match -nocase "c" [::msgcat::mclocale]]} {
	    ::msgcat::mclocale en
	}
	set locale [::msgcat::mclocale]
	
	# Avoid the mac encoding problems by rejecting certain locales.
	if {[tk windowingsystem] eq "aqua"} {
	    if {[regexp {ru} $locale]} {
		set locale en
		::msgcat::mclocale en
	    }
	}
    } else {
	set locale $prefs(messageLocale)
	::msgcat::mclocale $locale
    }

    set this(systemLocale) $locale
    set lang [lindex [split [file rootname $locale] _] 0]
    set langs [glob -nocomplain -tails -directory $this(msgcatPath) -- *.msg]
    set havecat 0
    foreach f $langs {
	set langcode [lindex [split [file rootname $f] _] 0]
	if {[string match -nocase ${langcode}* $locale]} {
	    set havecat 1
	    break
	}
    }
    if {!$havecat} {
	::msgcat::mclocale en
    }
    
    # Windows is not utf-8 by default
    encoding system utf-8
    
    # Test here if you want a particular message catalog (en, nl, de, fr, sv,...).
    #::msgcat::mclocale pl
    uplevel #0 [list ::msgcat::mcload $this(msgcatPath)]
    
    # This is a method to override default messages with custom ones for each
    # language.
    if {[file isdirectory $this(msgcatPostPath)]} {
	uplevel #0 [list ::msgcat::mcload $this(msgcatPostPath)]
    }
    uplevel #0 namespace import ::msgcat::mc
}

# From tcllib (fileutil) + modifications:

# ::Init::TempDir --
#
#	Return the correct directory to use for temporary files.
#	Python attempts this sequence, which seems logical:
#
#       1. The directory named by the `TMPDIR' environment variable.
#
#       2. The directory named by the `TEMP' environment variable.
#
#       3. The directory named by the `TMP' environment variable.
#
#       4. A platform-specific location:
#            * On Macintosh, the `Temporary Items' folder.
#
#            * On Windows, the directories `C:\\TEMP', `C:\\TMP',
#              `\\TEMP', and `\\TMP', in that order.
#
#            * On all other platforms, the directories `/tmp',
#              `/var/tmp', and `/usr/tmp', in that order.
#
#        5. As a last resort, the current working directory.
#
# Arguments:
#	None.
#
# Side Effects:
#	None.
#
# Results:
#	The directory for temporary files.

proc ::Init::TempDir {} {
    global  tcl_platform env
    
    set attempdirs [list]

    foreach tmp {TMPDIR TEMP TMP} {
	if {[info exists env($tmp)]} {
	    lappend attempdirs $env($tmp)
	}
    }

    switch $tcl_platform(platform) {
	windows {
	    lappend attempdirs "C:\\TEMP" "C:\\TMP" "\\TEMP" "\\TMP"
	}
	default {
	    lappend attempdirs [file join / tmp] \
		[file join / var tmp] [file join / usr tmp]
	}
    }

    foreach tmp $attempdirs {
	if {[file isdirectory $tmp] && [file writable $tmp]} {
	    return [file normalize $tmp]
	}
    }

    # If nothing else worked...
    return [file normalize [pwd]]
}

proc ::Init::LoadTkPng {} {
    global this
    
    # tkpng is required for the gui.
    if {[catch {package require tkpng 0.7}]} {
	tk_messageBox -icon error -title [::msgcat::mc "Error"] \
	  -message "The tkpng package is required for the GUI"
	exit
    }
    set this(package,tkpng) 1
}

proc ::Init::LoadPackages {} {
    global  this auto_path
    
    # Take precautions and load only our own treectrl.
	
    # tileqt has its own library support.
    if {[tk windowingsystem] eq "x11"} {
	namespace eval ::tileqt {}
	set ::tileqt::library [file join $this(binLibPath) tileqt]
    }
    
    # treectrl is required.
    ::Splash::SetMsg [mc "Looking for %s" treectrl]...
    set ::treectrl_library [file join $this(binLibPath) treectrl]
    if {[catch {package require treectrl 2.2} msg]} {
	tk_messageBox -icon error -title [::msgcat::mc "Error"] \
	  -message "This application requires the treectrl widget to work! $::errorInfo"
	exit
    }
    
    # Other utility packages that can be platform specific.
    # The 'Thread' package requires that the Tcl core has been built with support.
    array set extraPacksArr {
	macosx      {Itcl Tclapplescript tls Thread MacCarbonPrint carbon}
	windows     {Itcl printer gdi tls Thread optcl tcom}
	unix        {Itcl tls Thread}
    }
    foreach {platform packList} [array get extraPacksArr] {
	foreach name $packList {
	    set this(package,$name) 0
	}
    }
    foreach name $extraPacksArr($this(platform)) {
	::Splash::SetMsg [mc "Looking for %s" $name]...
	if {![catch {package require $name} msg]} {
	    set this(package,$name) 1
	} else {
	    ::Debug 2 "unable to load package: $name, reason: $msg"
	}
    }
    if {$this(package,Itcl)} {
	uplevel #0 {namespace import ::itcl::*}
    }
    if {!($this(package,printer) && $this(package,gdi))} {
	set this(package,printer) 0
    }

    # Not ready for this yet.
    set this(package,Thread) 0
}

# Init::Config --
# 
#       Sets any 'config' array entries.
#       The config array shall be used for hardcoded configuration settings
#       that can be overriden only at build time by adding a config.tcl file
#       in resources/. 
#       array set config {junk "The Junk" ...}

proc ::Init::Config {} {
    global  this config
    
    set f [file join $this(resourcePath) config.tcl]
    if {[file exists $f]} {
	source $f
    }
    
    # Let any user defined config file override hard coded and build configs.
    set f [file join $this(prefsPath) resources config.tcl]
    if {[file exists $f]} {
	source $f
    }
}

proc ::Init::SetHostname {} {
    global  this
    
    set this(hostname) [info hostname]
}

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