home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / libplugin / configuration.tcl next >
Encoding:
Text File  |  2000-11-02  |  3.9 KB  |  156 lines
  1.  
  2.  
  3. class dirDefinition {
  4.     variable dirMap
  5.     method getDirectiveByName { name }
  6.     method getDirectivesNames {} { 
  7.     return [array names dirMap]
  8.     }
  9.     method getDirectives {} { 
  10.     foreach one [array names dirMap] {
  11.         lappend result $dirMap($one)
  12.     }
  13.     return $result
  14.     }
  15.     method addDirectiveDefinition { xuiDirDefinitions }
  16. }
  17.  
  18. body  dirDefinition::addDirectiveDefinition { xuiDirDefinitions } {
  19.     set result {}
  20.     foreach xuiDirDef $xuiDirDefinitions {
  21.     foreach dir [$xuiDirDef getComponents] {
  22.         set dirMap([string tolower [$dir getName]]) $dir
  23.         lappend result $dir
  24.     }
  25.     }
  26.     return $result
  27. }
  28.  
  29. body dirDefinition::getDirectiveByName { name } {
  30.     set name [string tolower $name]
  31.     if [info exists dirMap($name)] {
  32.     return $dirMap($name)
  33.     } else { 
  34.     return {}
  35.     }
  36. }
  37.  
  38. class pPDefinition {
  39.     inherit dirDefinition
  40.     method getPPByName { name } {
  41.         getDirectiveByName $name
  42.     }
  43.     method addPPDefinition {xuiDirDefinitions} {
  44.     eval addDirectiveDefinition $xuiDirDefinitions
  45.     }
  46.     
  47. }
  48.  
  49.  
  50. class confDocument {
  51.    variable containerList {}
  52.    variable root {}
  53.    constructor {} {
  54.    set root [$this newContainer]
  55.    $root setName root
  56.    $root setClasses rootContainer
  57.    $root setLabel "Root Container"
  58.    }
  59.    method getRootContainer { } {return $root}
  60.    method addDirective { obj container }
  61.    method addContainer { container value class}
  62.    method getContainers { container }
  63.    method getDirectives { container }
  64.    method getDirectiveByName { container name}
  65.    method clear {}
  66.    method newContainer {}
  67.    method removeContainer { parentContainer container }
  68. }
  69.  
  70. body confDocument::clear {} {
  71.     eval delete object $root $containerList
  72.     set containerList {}
  73.     set root [$this newContainer]
  74.    $root setName root
  75.    $root setClasses rootContainer
  76.    $root setLabel "Root Container"
  77. }
  78. body confDocument::getContainers { container } {
  79.     set result {}
  80.     foreach cnt \
  81.         [[$container getComponentByName containerChildren] getChildren] {
  82.     lappend result [$cnt getValue]
  83.     }
  84.     return $result
  85. }
  86.  
  87.  
  88. body confDocument::getDirectiveByName { container name} {
  89.     return [[$container getComponentByName directiveChildren] \
  90.         getComponentByName $name ] 
  91. }
  92.  
  93. body confDocument::getDirectives { container } {
  94.     return [[$container getComponentByName directiveChildren] getComponents] 
  95. }
  96.  
  97. body confDocument::addDirective { obj container } {
  98.  
  99.    
  100.    [$container getComponentByName directiveChildren] addComponent $obj
  101.  
  102. }
  103.  
  104. body confDocument::addContainer { container value class} {
  105.     
  106.    set newCont [ $this newContainer ]
  107.    $newCont addClass $class
  108.    $newCont setName $value
  109.    
  110.    lappend containerList $newCont
  111.    
  112.    set contList [$container getComponentByName containerChildren]
  113.    set reference [$contList newChild]
  114.    $reference setValue $newCont
  115.    $reference setName $newCont
  116.    $contList insertChild $reference
  117.    return $newCont
  118. }
  119.  
  120.  
  121. body confDocument::newContainer {} {
  122.    set cont [xuiStructure ::#auto]
  123.    $cont setXuiClass Structure
  124.    $cont setStyle normal
  125.    $cont setAlign vertical
  126.    
  127.    set list [ xuiList ::#auto ]
  128.    $list setName containerChildren
  129.    set pt [xuiString ::#auto]
  130.    $pt setXuiClass string
  131.    $list setPrototype $pt
  132.    
  133.    $cont addComponent $list
  134.    
  135.    set st [xuiStructure ::#auto]
  136.    $st setName directiveChildren
  137.    $st setLabel directiveChildren
  138.    $st setXuiClass structure
  139.    
  140.    $cont addComponent $st
  141.    
  142.    return $cont
  143. }
  144.  
  145.  
  146. body confDocument::removeContainer { parentContainer container } {
  147.     #containerChildren is a string of xuiStrings whose values are 
  148.     # names of xuiContainer
  149.     set myContainerList [$parentContainer getComponentByName containerChildren]
  150.     $myContainerList deleteChild \
  151.             [$myContainerList getChildrenByName $container]
  152.     lremove containerList $container
  153.     destroy object $container
  154. }
  155.  
  156.