Posted to tcl by aspect at Thu Jul 10 02:05:45 GMT 2014view raw
- # warning - copy/pasted from parts of a working system, but not tested, so probably buggy as written
- oo::class create ConfigInterp {
- variable interp
- variable state ;# context for the current token
- variable world ;# the config object that is being created
- constructor {script} {
- set interp [interp create -safe]
- $interp alias unknown [self]
- set state(section) ""
- my eval $script
- }
- method get args {
- array get world {*}$args
- }
- method eval {script} {
- $interp eval $script
- }
- method unknown {args} {
- puts "Unknown: [regexp -inline -line {.{0,40}} [join $args " "]]"
- }
- # these are to be used in the config script:
- method version {str} {
- set world(version) $str
- }
- method section {name script} {
- set oldsec $state(section)
- lappend state(section) $name
- try {
- $interp eval $script
- } finally {
- set state(section) oldsec
- }
- }
- }
- # Usage is something like:
- puts [open config.tcl w] {
- version "Testing"
- section foo {
- section bar {}
- section baz {}
- }
- }
- set ci [ConfigInterp create]
- $ci eval [readfile config.tcl] ;# eg
- array set config [$ci get]