(needs to be documented, just here for completeness)
# Modul: initscript.tcl
# Stand: 21.04.2009
# Zweck: Allgemeine Script-Initialisierungen
# Autor: M.Hoffmann (c) 2005-2009
# ToDo:
# * Da jetzt main-Script immer app-main heisst, kann kein Scripttitel
# automatisch abgeleitet werden!
# 17.02.2006: encoding-Processing broken mit 8.4.12!!!
# 03.03.2006: Nach Rückkehr zu 8.4.11 encoding wieder aktiviert.
# 13.02.2007: Bugfixes, Verbesserungen.
# 18.05.2007: Immer _myPath path mit _initVars zurückgeben, Proc _initSource;
# Bugfix: .RC-Namensermittlung geändert.
# 28.06.2007: arg für _initSource kann eine Liste aus mehreren Namen sein;
# jedes arg für _initScript kann selbst eine Liste sein, daher werden
# die `package requires` dort mit `eval` ausgeführt (ACHTUNG!);
# Unterstützung von `autoclone`: Nutzung des ursprünglichen .EXE-Pfads
# zur Ermittlung des Profilpfades (ungetestet): autoCloneOrgPath;
# Am Ende auch noch eine <profile.rc> aus dem Userhome laden;
# _initScript gibt Namen und Ergebnisse von package require zurück;
# Neue Variable _myName wird zurückgegeben;
# v0.5
# 13.09.2007: Varianten _initSource2 und _initVars2 verwenden 'args' (Wrapper).
# 20.09.2007: Bugfix: _initSource2-Fehler, wenn Blank in Ordnernamen.
# 21.04.2009: fconfigure für StdChannels nicht für v8.5
package provide initscript 0.6;
package require readprof; # MHo
################################################################################
# Grundsätzliche Skriptinitialisierung:
# - Automatisches Einbinden von Modulen anhand user-supplied VFS/lib/import.Index
# - Einbinden der ggF. als Argument übergebenen Module. Alle Module, die nicht
# aus dem Repository mittels import.Index eingebunden werden, sondern die der
# Benutzer selbst in das VFS aufnimmt (weil sie z.B. Anwendungsindividuell
# sind), MÜSSEN hier an initScript() übergeben werden!
#
proc _initScript {args} {
# Besser [::starkit::topdir]? -> nachlesen!
set ret [list ]
set libRoot [file normalize [file join [file dirname [info script]] .. .. lib]]
set imports [list import.tcl importSys.tcl]
foreach import $imports {
if {[file exists [file join $libRoot $import]]} {
if {[catch {
source [file join $libRoot $import]
} rc]} {
_initAbort "Fehler bei der automatischen Einbindung von Modulen aus import.Index:\n$rc"
}
}
}
foreach arg $args {
if {[catch {
lappend ret "$arg [eval package require $arg]"
} rc]} {
_initAbort "Fehler bei der automatischen Einbindung von Modulen via initScript():\n\n$rc"
}
}
# Erforderlich, weil zuätzliche ENCODINGS in VFS/lib eingebunden werden,
# siehe https://wiki.tcl-lang.org/52 ff.
# siehe https://wiki.tcl-lang.org/3661
if {[info commands librarypath] == "librarypath"} {
# Anweisung nur ausführen in starpacks/starkits
librarypath $libRoot
}
# alternativ: im VFS tcl8.4/encoding VORHER anlegen und dort ZUSÄTZLICHE
# encodings hineinkopieren; diese sind dann auch da:
if {[info tclversion] < 8.5} {
foreach {channel} {stdin stdout stderr} {
catch {fconfigure $channel -encoding cp850}; # oder cp437?
}
return $ret
}
}
################################################################################
# je nach Umgebung Fehlermeldung in MsgBox (Tk/GUI) oder nach STDERR ausgeben
# und Programmende mit rc(255) abbrechen ohne weitere Maßnahmen
# (früher Not-Ausstieg!)
#
proc _initAbort {msg} {
if [info exists ::tk_version] {
wm withdraw .
tk_messageBox -icon error \
-type ok \
-title {Fehler:} \
-message "$msg\n\n(RC 255)"
} else {
puts stderr "Fehler:\n\n$msg\n\n(RC 255)"
}
exit 255
}
################################################################################
# Liefert eine Liste von Variablen zurück, aufgebaut aus
# 1) der übergebenen Liste (sofern angegeben)
# 2) aus einer .RC-Datei im .EXE-Pfad, gleichen Namens, sofern vorhanden
# (Das müsste nun auch noch mit der Kommandozeile verknüpft werden, dann wäre
# es perfekt!)
#
proc _initVars {vars} {
set exe [file normalize [info nameofexecutable]]
set scr [file normalize [info script]]
set prf [expr {[string first $exe $scr] == -1 ? $scr : $exe}]
set prf [file rootname $prf].rc
# Erweiterung: autoclone hat Programm von TEMP gestartet; Profil im OrgPfad suchen!
if {[info commands autoCloneOrgPath] == "autoCloneOrgPath"} {
if {[string first $exe $scr] == 0} {
set prf [file rootname [autoCloneOrgPath]].rc
}
}
lappend vars _myPath [file normalize [file dirname [info script]]]
lappend vars _myName [file rootname [file tail $prf]]
set prfH [file join ~ [file tail $prf]]
return [readprof::readprof1 [list $prf $prfH] $vars]
}
proc _initVars2 {args} {
return [uplevel _initVars [list $args]]
}
################################################################################
# Vereinfacht das SOURCEn von Submodulen aus dem Mainmodul, wenn diese im
# gleichen Ordner stehen (im Zuge einer sauberen Modularisierung des Hauptpgms)
#
proc _initSource {what} {
# kein CATCH, Fehler sollen zum Abbruch führen!
foreach w $what {
uplevel [list source [file join [file dirname [info script]] $w]]
}
}
proc _initSource2 {args} {
uplevel _initSource [list $args]
}