---- # 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 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 http://mini.net/tcl/52 ff. # siehe http://wiki.tcl.tk/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] } } ---- # 28.07.2007 # ACHTUNG bei Änderungen in readprof: WAS IST BETROFFEN (pkgTools?) package require autoclone; # MHo http://wiki.tcl.tk/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" ----