home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / gui / guiPropertyPages.tcl < prev    next >
Text File  |  2000-11-02  |  4KB  |  135 lines
  1.  
  2.  
  3. class guiPropertyPages {
  4.     inherit guiObject
  5.     variable elements {}
  6.     variable createdItems
  7.     variable noteBook
  8.     variable contframe
  9.     variable pw
  10.     variable tree
  11.     variable guiBuilder
  12.     variable currentPropertyPageXui
  13.     constructor { frame xuiObject gBuilder} {
  14.         array set createdItems ""
  15.     set subject $xuiObject
  16.     set guiBuilder $gBuilder
  17.     set i 0
  18.     set pw [PanedWindow $frame.pw -side bottom]
  19.     $pw add
  20.     $pw add
  21.     set contframe [$pw getframe 0]
  22.         set scwin [ScrolledWindow $contframe.scwin]
  23.     set tree [Tree $scwin.tree \
  24.                 -deltay 22\
  25.                 -bg white\
  26.                 -showlines true\
  27.                 -deltax 14\
  28.                 ]
  29.     $tree bindText <ButtonPress-1> \
  30.                 "$this selectItem"
  31.  
  32.     set noteBook [PagesManager [$pw getframe 1].nb]
  33.  
  34.     # We may have to implement 2 passes if we
  35.     # have to add under a node not yet exists
  36.     set els [getOrderedList [$subject getComponents]]
  37.     set items {}
  38.     foreach item $els {
  39.         set itemName [$item getName]
  40.         
  41.         # If at this point parent does not exist, we just hook it under root
  42.  
  43.             set parent [$item cget -hookUnder]
  44.         if ![$tree exists $parent] { set parent root }
  45.         set newFrame  [$noteBook add $itemName]        
  46.         $tree insert end $parent $itemName -text [$item getLabel] \
  47.             -image [$item cget -icon] -data [list $newFrame $item]
  48.         lappend items $itemName
  49.     }
  50.  
  51.     pack $contframe -fill both -expand true
  52.     pack $tree -fill both -expand true
  53.     $scwin setwidget $tree
  54.     pack $scwin -fill both -expand true 
  55.     pack $pw -fill both -expand true                       
  56.     selectItem  [lindex $items 0]
  57.     }
  58.     destructor {
  59.     eval delete object $elements
  60.     eval destroy $noteBook
  61.     eval destroy $contframe
  62.     eval destroy $pw
  63.     }
  64.     method selectItem { node } {
  65.     
  66.         # On the fly creation
  67.  
  68.         if ![info exists createdItems($node)] {
  69.         pack forget $noteBook
  70.         pack forget [$pw getframe 1]
  71.         foreach {newFrame item} [$tree itemcget $node -data] break;
  72.         set element [$guiBuilder render $newFrame $item]
  73.         lappend elements $element
  74.         set createdItems($node) $item
  75.         $noteBook compute_size
  76.         pack $noteBook  -side left -fill both -expand true -padx 4
  77.         pack [$pw getframe 1] -fill both -expand true
  78.     }
  79.     $tree selection set $node 
  80.     $noteBook raise $node
  81.     set currentPropertyPageXui $createdItems($node)
  82.     }
  83.     method enable {}
  84.     method disable {}
  85.     method queryState {} 
  86.     method getSelectedPropertyPageXui {}
  87. }
  88.  
  89. body  ::guiPropertyPages::getSelectedPropertyPageXui {} {
  90.     return $currentPropertyPageXui
  91. }
  92.  
  93. proc getOrderedList { list } {
  94.    set oldList $list
  95.    set list [figureOutOrder $list root]
  96.    
  97.    # The ones that do not have a parent but hookUnder!= root, 
  98.    # We put them under root (this is for example is modle that provides parent
  99.    # is not configured)
  100.    
  101.    foreach el $oldList {
  102.        if [expr [lsearch $list $el] == -1] {
  103.            lappend list $el
  104.        $el configure -hookUnder root
  105.        }
  106.    }
  107.    return $list
  108. }
  109.  
  110. proc figureOutOrder { list start } {
  111.     set newList [ getAllThatHookUnder $list $start ]
  112.     foreach one $newList {
  113.     lremove list $one
  114.     }
  115.     set ordered $newList
  116.     foreach one $newList {
  117.     set ordered [concat $ordered [figureOutOrder $list [$one getName] ]]
  118.     }
  119.     return $ordered 
  120. }
  121.  
  122. proc getAllThatHookUnder { list hookPoint } {
  123.     set result {}
  124.     foreach one $list {
  125.         if ![llength [$one cget -hookUnder]] {
  126.         $one configure -hookUnder root
  127.     }
  128.     if ![string compare [$one cget -hookUnder] $hookPoint] {
  129.         lappend result $one
  130.     }
  131.     }
  132.  
  133.     return $result
  134. }
  135.