# Modul: initscript.tcl
# Stand: 28.06.2007
# Zweck: Allgemeine Script-Initialisierungen
# Autor: M.Hoffmann (c) 2005-2007
# 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;
package provide initscript 0.4;
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, weils 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:
foreach {channel} {stdin stdout stderr} {
fconfigure $channel -encoding cp850; # oder 437?
}
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]
}
################################################################################
# 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 source [file join [file dirname [info script]] $w]
}
}UKo 2007-07-05: Why don't you use the standard error mechanism in _initAbort? It uses the standard bgerror dialog if no console is present and the console otherwise. If you require a dialog if Tk is present you can easily use "bgerror" instead of your custom dialog. So the easiest way is to test for bgerror and use it if present, otherwise use error. MHo Thank you, I never thought this way. I will test a little bit and do the changes you suggest...
# 28.07.2007
# ACHTUNG bei Änderungen in readprof: WAS IST BETROFFEN (pkgTools?)
package require autoclone; # MHo https://wiki.tcl-lang.org/14945
set auto_path [linsert $auto_path 0 [pwd]];
puts "\$auto_path: $auto_path\n"
puts "package require initscript 0.4: [package require initscript 0.4]\n"
puts "_initScript ...: [_initScript execx bgexec]\n"
array set _init [_initVars {
variable1 defaultWert1
variable2 {defaultWert2-TeilA defaultWert2-TeilB}
variable3 {defaultWert3-TeilA defaultWert3-TeilB}
feld1 {v1 w1 v2 w2 v3 w3}
feld2 {}
}]
parray _init
puts {}
puts $_init(variable1)
# Hier ist bereits ein Fehler. Alles, was aus READPROF kommt,
# ist mit {} gequoted...
array set f1 $_init(feld1)
parray f1
# dies soll nun von aussen, aus .rc, kommen. Entspricht dem Einrichten USERALIAS über .RC.
# und genau dies geht nicht: alles, was dort eingelesen wird, wird immer als EIN Wert betrachtet, egal
# wie und ob man in .RC quoted! Selbst split hilft nicht! Sehr kniffelig....
# es geht wohl nur so:
set _init(feld2) [split [join $_init(feld2)]]
array set f2 $_init(feld2)
parray f2
# ABER WARUM????????
# na gut, die Interpretation eines von readprof gelieferten Wertes obliegt ja eigentlich dem Programm.
# wenn der Wert eben eine Liste sein soll für array set, muss man diese wohl erzeugen.......
# aber dies kann man in der RC-Datei ja schlecht machen... dort können nur KONSTANTEN stehen.... variable1 {Dies sind die Überschreibungen für
Variable1}
variable2 Neuer Wert2 \
und dies dahinter
#feld2 aa 11 bb 22
#feld2 {aa 11 bb 22}
feld2 "aa 11 bb 22"