Posted to tcl by aspect at Thu Jul 10 02:05:45 GMT 2014view raw

  1. # warning - copy/pasted from parts of a working system, but not tested, so probably buggy as written
  2.  
  3. oo::class create ConfigInterp {
  4. variable interp
  5.  
  6. variable state ;# context for the current token
  7. variable world ;# the config object that is being created
  8.  
  9. constructor {script} {
  10. set interp [interp create -safe]
  11. $interp alias unknown [self]
  12. set state(section) ""
  13. my eval $script
  14. }
  15. method get args {
  16. array get world {*}$args
  17. }
  18. method eval {script} {
  19. $interp eval $script
  20. }
  21. method unknown {args} {
  22. puts "Unknown: [regexp -inline -line {.{0,40}} [join $args " "]]"
  23. }
  24.  
  25. # these are to be used in the config script:
  26.  
  27. method version {str} {
  28. set world(version) $str
  29. }
  30.  
  31. method section {name script} {
  32. set oldsec $state(section)
  33. lappend state(section) $name
  34. try {
  35. $interp eval $script
  36. } finally {
  37. set state(section) oldsec
  38. }
  39. }
  40. }
  41.  
  42. # Usage is something like:
  43.  
  44. puts [open config.tcl w] {
  45. version "Testing"
  46. section foo {
  47. section bar {}
  48. section baz {}
  49. }
  50. }
  51.  
  52. set ci [ConfigInterp create]
  53. $ci eval [readfile config.tcl] ;# eg
  54. array set config [$ci get]