[MSW](2005-02-24)

----
 # test:
 # --<<snip>>--
 # package require -exact Init 0.1
 # namespace import Init::*
 #
 # onInit -type procedure -proc { puts stderr "Init 1" }
 # onInit -type procedure -proc { puts stderr "Init 2" }
 # onInit -type cleanup -cleanup { puts stderr "Cleanup 1" }
 # onInit -type cleanup -cleanup { puts stderr "cleanup 2" }
 # onInit -type procedure -proc { puts stderr "Init 3" }
 #
 # onInit -type file -filePrefix "bla_" -fileSuffix ".tcl" \
 #         -fileDirs {/home/phaeton/programming/test-src} \
 #         -fileList {_cvs_ _help_ _init_ _proc_decl_}
 #
 # doInit
 #
 # array set pref {}
 #
 # traverse pref
 #
 # parray pref
 #
 # puts "Hit key to continue"
 # gets stdin
 #
 # onInit -type file -filePrefix "bla_" -fileSuffix ".tcl" \
 #         -fileDirs {/home/phaeton/programming/test-src} \
 #         -fileList {_cvs_ _hep_ _ini_ _pro_decl_}
 #
 # reInit
 # array set pref2 {}
 # traverse pref2
 # puts "hit key to view pref"
 # gets stdin
 # parray pref
 # puts "hit key to view pref2"
 # gets stdin
 # parray pref2
 # --<<snap>>--
 #
 # Whether init automatically initializes or not, should
 # be version number dependant. You require 0.1, no auto
 # init, you require 0.2 (which will be default since it
 # has a higher version number) and autoinit takes place.
 #
 ## -- SOC -- Start of Code (searchmark:)
 ## -- namespace mungodjungo
 namespace eval Init {
 	namespace export traverse reInit doInit doFinalize onInit reset
 ## let's start it
 
 variable iState
 variable doneInit 0
 variable iFFound
 
 array set iFFound {}
 
 array set iState {}
 
 ## traverse (array)
 ## traverses init state to array named in array
 proc traverse { arrN } {
     variable iState
     upvar $arrN target
     foreach name [array names iState] {
         set target($name) $iState($name)
     }
 }
 
 ## --- Interface to set Init actions --
 ## onInit ( args )
 proc onInit { args } {
     variable doneInit
     variable ::initInfo
     set fileSuffix [list]
     set filePrefix [list]
     set fileList   [list]
     set dirList    [list]
     set block      [list]
     set type        ""
 
     if {$doneInit} {
         puts stderr "Warning: onInit: initialized already, do reInit to see the effect!"
     }
     set numargs [llength $args]
     if {!$numargs} {
         puts stderr "onInit called without arguments!"
         return
     }
     ## if called with -copy, just return the current initInfo
     ## if called with -pop, pop off the last element of the list.
     if {($numargs == 1) } {
         if {[lindex $args 0] == "-copy"} {
             puts stderr "traversing initInfo."
             return $initInfo
         } elseif { [lindex $args 0] == "-pop"} {
             set tmp [lindex $initInfo end]
             set initInfo [lreplace $initInfo end end]
             puts stderr "Popping of initInfo: <$tmp>"
             return $tmp
         }
     }
     for {set i 0} {$i < $numargs} {incr i} {
         set j [expr $i +1]
         set step 0
         switch -glob -- [set cur_arg [lindex $args $i]] {
             "-*"    {
                     switch -glob -- [set cur_arg [string range $cur_arg 1 end]] {
                         "type"  {
                             set data [string tolower [lindex $args $j]]
                             if {!(($data == "cleanup")||($data=="procedure")||($data=="file"))} {
                                 puts stderr "onInit: -$cur_arg <$data>: Cannot recognize \"$data\"!"
                             }
                             set type $data
                             incr step
                             }
                         "file*" {
                             switch -- $cur_arg {
                                 "fileSuffix"    { set fileSuffix [lindex $args $j]; incr step }
                                 "filePrefix"    { set filePrefix [lindex $args $j]; incr step }
                                 "fileList"      { set fileList  [lindex $args $j]; incr step }
                                 "fileDirs"      { set dirList   [lindex $args $j]; incr step }
                                 default { puts stderr "onInit: Do not recognize file sub opt \"-$cur_arg\"" }
                             }
                             }
                         "proc" {
                             set block [lindex $args $j] ; incr step
                             }
                         "cleanup" {
                             set block [lindex $args $j] ; incr step
                             }
                         default     {
                             puts stderr "Unknown option -$cur_arg!"
                             }
                     }
                 }
             default {
                     puts stderr "Unknown argument $cur_arg"
                 }
         }
         incr i $step
     }
     if {$type == ""} {
         puts stderr "onInit: lacking type specification!"
         return
     }
     if {$type == "file"} {
         lappend initInfo [list $type [list $filePrefix $fileList $fileSuffix $dirList]]
     } else {
         lappend initInfo [list $type $block]
     }
 }
 
 ## reInit just does reinitialization
 proc reInit { } {
     variable doneInit
     variable iState
     variable iFFound
     doFinalize
     set doneInit 0
     array set iState {}
     array set iFFound {}
     doInit
 }
 
 ## reset clears the current state.
 proc reset { } {
     variable ::initInfo
     variable doneInit
     variable iState
     variable iFFound
     set doneInit 0
     array set iState {}
     array set iFFound {}
     unset initInfo
 }
 
 ## doFinalize reads the global variable initInfo
 ## which can be set by the caller, and searches
 ## for entries named Cleanup, and evaluates them.
 ## This is a special form of the Procedure spec,
 ## which causes the correlated calls to be performed
 ## at reinitialization time, where you may want to
 ## perform cleanups and such.
 
 proc doFinalize { } {
     variable ::initInfo
     if {![info exists initInfo]} {
         puts stderr "doFinalize([info level [info level]]): No initInfo found!"
         return
     }
     foreach entry $initInfo {
         if {[lindex $entry 0] == "cleanup"} {
             if [catch {uplevel #0 [lindex $entry 1]} errInf] {
                 puts stderr "doFinalize([info level [info level]]): Error in code block!"
                 puts stderr "codeblock was: <<[lindex $entry 1]>>"
                 puts stderr "thrown error: $errInf"
             }
         }
     }
     return
 }
 
 ## doInit reads the global variable initInfo
 ## which can be set by the caller. Currently
 ## initInfo consists of a simple list:
 ## < <Init-type> <Init-type-info> >,
 ## there can be multiple init-type, init-type-info
 ## tuples, all will be attempted to handled.
 ## current handling works for:
 ## Init-type		Init-type-info
 ## ----------------------------------------------------------
 ## file				< <prefix> <name(s)> <suffix> <dir(s)> >
 ## 	>> Sets in the local state array entries with the filenames
 ##	>> of the files, like banzai/bla.x comes as bla.x into the
 ##	>> array. files following [_]pattern[_] ([] meaning optional)
 ##	>> will be renamed, where the leading underscore gets replaced
 ##	>> with prefix, and the trailing one with suffix.
 ## procedure		< <procedure <arg> [<arg> ..]> >
 ##	>> Calls the listed procedure
 ## cleanup          < valid tcl cmd >
 ##  >> Evaluates each block on global level to perform cleanups
 ##  >> in the underlying program.
 ## 
 
 proc doInit { } {
 	variable ::initInfo
     variable ::env
 	variable doneInit
     variable iState
     variable iFFound
 	if {$doneInit} {
 		puts stderr "Warning, reInit ?!"
 	}
 	if {![info exists initInfo]} {
 		puts stderr " Cannot find initInfo !!! "
 	} else {
 		foreach entry $initInfo {
 			switch -- [lindex $entry 0] {
                 "cleanup"   { continue }
 				"procedure"	{ if [catch {uplevel #0 [lindex $entry 1]} errInf] {
                         puts stderr "doInit([info level [info level]]): Error in code block!"
                         puts stderr "codeblock was: <<[lindex $entry 1]>>"
                         puts stderr "thrown error: $errInf"
                     }
                     }
 				"file"		{
 					#puts stderr " -- search for files -- "
 					set l [lindex $entry 1]
 					set prefix [lindex $l 0]
 					set suffix [lindex $l 2]
 					set names [lindex $l 1]
 					set dirs [lindex $l 3]
 					#puts stderr " Prefix: $prefix, Suffix: $suffix."
 					#puts stderr " Files: $names "
 					#puts stderr " Dirs: $dirs"
                     foreach fil $names {
                         if {[string index $fil 0] == "_"} { set fil [string replace $fil 0 0 $prefix] }
                         if {[string index $fil end] == "_"} { set fil [string replace $fil end end $suffix] }
                         set iFFound([lindex [file split $fil] end]) 0
                         foreach dir $dirs {
                             set fpath [file join $dir $fil]
                             if {[file exists $fpath] && [file readable $fpath]} {
                                 set fil [lindex [file split $fil] end]
                                 set iState($fil) $fpath
                                 set iFFound($fil) 1
                                 break
                             }
                         }
                     }
                     if {[lsearch [array get iFFound] 0] != -1} {
                         if {[info exists env(INIT_DEBUG)] && $env(INIT_DEBUG) == 1} {
                             puts stderr " WARNING! Could not find all files. Continue ? \[yn\] "
                             puts stderr " --------------- File status -----------------------"
                             foreach name [array names iFFound] {
                             puts stderr [format "%-40s:........%d" $name $iFFound($name)]
                             }
                             puts -nonewline stderr " Choice ? \[yn\] :"
                             set ans [gets stdin]
                             if {$ans == "y"} {
                             puts stderr " You're driving at own risk, continuing... "
                             } else {
                             puts stderr " Exitting (user choice) "
                             exit 1
                             }
                         } else {
                             puts stderr " Bang ! Some files not found (set INIT_DEBUG to 1 in your environment "
                             puts stderr " for more information on what files were not found.) Exitting now. "
                             exit 1
                         }
                     }
 
 				}
 				default	{ puts stderr "Unknown entry $entry!!" }
 			}
 		}
         set doneInit 1
 	}
 }
 
 ## <<--- closing the namespace mungodjungo
 }
 ## --->>
 
 ## Do the actual init.
 if {$::dofastinit} {
     Init::doInit
     package provide Init 0.2
 } else {
     package provide Init 0.1
 }

----