home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / treenode.tcl < prev    next >
Text File  |  1997-11-25  |  12KB  |  506 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)treenode.tcl    /main/titanic/33
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)treenode.tcl    /main/titanic/33   25 Nov 1997 Copyright 1997 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12. # End user added include file section
  13.  
  14.  
  15. Class TreeNode : {BrowsNode} {
  16.     constructor
  17.     method destructor
  18.     method appendChildren
  19.     method getParent
  20.     method getPreviousNode
  21.     method getLevelPath
  22.     method switchContext
  23.     method open
  24.     method rebuild
  25.     method remove
  26.     method removeChildren
  27.     method update
  28.     method addChildLabel
  29.     method removeChildLabel
  30.     method addOldChild
  31.     method removeOldChild
  32.     attribute count
  33.     attribute childLabelSet
  34.     attribute oldChildSet
  35.     attribute browsUiObj
  36. }
  37.  
  38. constructor TreeNode {class this name browsUiObj} {
  39.     set this [BrowsNode::constructor $class $this $name]
  40.     $this browsUiObj $browsUiObj
  41.     $this childLabelSet [List new]
  42.     $this oldChildSet [List new]
  43.     # Start constructor user section
  44.  
  45.     global ${browsUiObj}::treeNode
  46.     set ${browsUiObj}::treeNode $this
  47.  
  48.     $this count 0
  49.     $this update
  50.     $this config \
  51.         -activeState 0 \
  52.         -selectState 0 \
  53.         -activated {%this open} \
  54.         -folded {%this removeChildren} \
  55.         -unFolded {%this appendChildren}
  56.  
  57.     # Append children if current one is unfolded
  58.     if {! [$this foldState]} {
  59.         $this appendChildren
  60.     }
  61.  
  62.     # promote to DragTreeNode if node can be dragged
  63.         if [$browsUiObj canBeDragged] {
  64.             require "dragtreeno.tcl"
  65.             DragTreeNode promote $this
  66.         }
  67.  
  68.     # End constructor user section
  69.     return $this
  70. }
  71.  
  72. method TreeNode::destructor {this} {
  73.     # Start destructor user section
  74.     # End destructor user section
  75. }
  76.  
  77.  
  78. # Append the children of the current object in the
  79. # tree view if unfolded.
  80. #
  81. method TreeNode::appendChildren {this {scrollFlag 1}} {
  82.     set clientContext [ClientContext::global]
  83.     set oldLevelPath [$clientContext currentLevelIdString]
  84.     set switched 0
  85.  
  86.     # execute this code in context of this node.
  87.     set newLevelPath [$this getLevelPath]
  88.     if {$newLevelPath != "" && $newLevelPath != $oldLevelPath} {
  89.     $this switchContext $newLevelPath
  90.     set switched 1
  91.     }
  92.  
  93.     # object may have been promoted already by previous open
  94.     # call module_promoter again, maybe this will repair the damage
  95.     set browsUiObj [$this browsUiObj]
  96.     module_promoter [$browsUiObj browserObjType] $browsUiObj
  97.  
  98.     if {! [$browsUiObj hasChildren]} {
  99.     if $switched {
  100.         $this switchContext $oldLevelPath
  101.     }
  102.     return
  103.     }
  104.  
  105.     busy {
  106.     # initialize
  107.     BrowserProcs::initializeInfo $browsUiObj $this
  108.     set errorStack [$browsUiObj initializeChildSet ""]
  109.     if {"$errorStack" != ""} {
  110.         if [info exists errorInfo] {
  111.         set errorInfoCopy $errorInfo
  112.         } else {
  113.         set errorInfoCopy ""
  114.         }
  115.         if [info exists errorCode] {
  116.         set errorCodeCopy $errorCode
  117.         } else {
  118.         set errorCodeCopy ""
  119.         }
  120.         resetErrorVars
  121.     }
  122.  
  123.     set index 0
  124.     [$this oldChildSet] contents [$this childSet]
  125.     [$this oldChildSet] foreach node {
  126.         set browsUiObjSet([$node browsUiObj]) $node
  127.         set oldIndex($node) [$node index]
  128.     }
  129.  
  130.     foreach association [[$browsUiObj browserObjType]::associations] {
  131.         case "$association" in {
  132.         {controlledClasses externalFiles phaseVersions sections} {
  133.             set sort 0
  134.         }
  135.         {default} {
  136.             set sort 1
  137.             [$this childLabelSet] contents ""
  138.         }
  139.         }
  140.  
  141.         foreach child [$browsUiObj getChildSet $association] {
  142.         # Skip non-containers
  143.         if {! [$child hasChildren]} {
  144.             BrowserProcs::initializeInfo $child $this
  145.             continue
  146.         }
  147.  
  148.         if [info exists browsUiObjSet($child)] {
  149.             set node $browsUiObjSet($child)
  150.         } else {
  151.             set node ""
  152.         }
  153.  
  154.         if {"$node" == ""} {
  155.             set node $this.node[$this count]
  156.             $this count [expr [$this count] + 1]
  157.             TreeNode new $node $child
  158.             $this addOldChild $node
  159.         } else {
  160.             $node update
  161.         }
  162.         if {"[$node icon]" == ""} continue
  163.         $this removeOldChild $node
  164.  
  165.         if $sort {
  166.             $this addChildLabel [list "[$node label]" $node]
  167.         } else {
  168.             $node index $index
  169.             incr index 1
  170.         }
  171.         }
  172.  
  173.         if {! $sort} continue
  174.  
  175.         # Sort the nodes on label
  176.         [$this childLabelSet] sort
  177.         [$this childLabelSet] foreach tuple {
  178.         [lindex $tuple 1] index $index
  179.         incr index 1
  180.         }
  181.     }
  182.     [$this oldChildSet] foreach node {
  183.         if [info exists oldIndex($node)] {
  184.         set startIndex $oldIndex($node)
  185.         } else {
  186.         set startIndex -1
  187.         }
  188.         $node remove $startIndex
  189.     }
  190.     if $scrollFlag {
  191.         $this makeVisible
  192.     }
  193.     }
  194.  
  195.     if {"$errorStack" != ""} {
  196.     global errorInfo errorCode
  197.     set errorInfo $errorInfoCopy
  198.     set errorCode $errorCodeCopy
  199.     wmtkerror $errorStack
  200.     }
  201.  
  202.     if {$switched && $newLevelPath == [$clientContext currentLevelIdString]} {
  203.     $this switchContext $oldLevelPath
  204.     }
  205. }
  206.  
  207. method TreeNode::getParent {this type} {
  208.     set browsUiObj ""
  209.     set found 0
  210.     for {set parent [$this parent]} \
  211.     {"$parent" != ""} \
  212.     {set parent [$parent parent]} {
  213.     set browsUiObj [$parent browsUiObj]
  214.     if {"$browsUiObj" == ""} break
  215.     if [$browsUiObj isA $type] {
  216.         set found 1
  217.         break
  218.     }
  219.     }
  220.     if $found {
  221.     return $browsUiObj
  222.     }
  223.     return ""
  224. }
  225.  
  226. method TreeNode::getPreviousNode {this {force 0} {startIndex -1}} {
  227.     # Cannot determine previous for root nodes
  228.     set parent [$this parent]
  229.     if {"$parent" == ""} {
  230.     return $this
  231.     }
  232.  
  233.     global treeNodeStartIndex treeNodeIndex
  234.     if {! [info exists treeNodeStartIndex]} {
  235.     if {$startIndex < 0} {
  236.         set startIndex [$this index]
  237.     }
  238.     set treeNodeStartIndex $startIndex
  239.     set treeNodeIndex $treeNodeStartIndex
  240.     }
  241.  
  242.     # Select this node first because setCurrentObj uses the selectedObjSet
  243.     $this selectState 1
  244.  
  245.     if {$force || [catch {.main setCurrentObj $this}]} {
  246.     set doNextIndex [expr 1 - $force]
  247.     set childSet [$parent childSet]
  248.  
  249.     if $force {
  250.         if {$treeNodeIndex >= [llength $childSet]} {
  251.         set treeNodeIndex 0
  252.         }
  253.         set node [lindex $childSet $treeNodeIndex]
  254.         if {$node == $this} {
  255.         set doNextIndex 1
  256.         }
  257.     }
  258.  
  259.     if $doNextIndex {
  260.         if {$treeNodeIndex <= $treeNodeStartIndex && $treeNodeIndex > 0} {
  261.         incr treeNodeIndex -1
  262.         } else {
  263.         if {$treeNodeIndex == 0} {
  264.             set treeNodeIndex $treeNodeStartIndex
  265.         }
  266.         incr treeNodeIndex
  267.         }
  268.         set node [lindex $childSet $treeNodeIndex]
  269.     }
  270.     if {"$node" != ""} {
  271.         return [$node getPreviousNode]
  272.     }
  273.     unset treeNodeStartIndex
  274.     return [$parent getPreviousNode]
  275.     }
  276.  
  277.     unset treeNodeStartIndex
  278.     $this activeState 1
  279.     return $this
  280. }
  281.  
  282.  
  283. # Return level ID path of this tree node.
  284. #
  285. method TreeNode::getLevelPath {this} {
  286.     # determine levelpath of this node
  287.     set treeNode $this
  288.     set levelPath ""
  289.     while { $treeNode != "" } {
  290.     if {[[$treeNode browsUiObj] isA CustomLevelVersion]} {
  291.         set levelPathPart [[$treeNode browsUiObj] identity]
  292.         set levelPath "/${levelPathPart}$levelPath"
  293.     }
  294.     set treeNode [$treeNode parent]
  295.     }
  296.  
  297.     return $levelPath
  298. }
  299.  
  300.  
  301. # Perform context switch to specified levelPath.
  302. #
  303. method TreeNode::switchContext {this levelPath} {
  304.     set clientContext [ClientContext::global]
  305.     $clientContext notifyDisable
  306.  
  307.     if [info exists errorInfo] {
  308.     set errorInfoCopy $errorInfo
  309.     } else {
  310.     set errorInfoCopy ""
  311.     }
  312.     if [info exists errorCode] {
  313.     set errorCodeCopy $errorCode
  314.     } else {
  315.     set errorCodeCopy ""
  316.     }
  317.     if [catch {$clientContext setLevelIds $levelPath}] {
  318.     global errorInfo errorCode
  319.     set errorInfo $errorInfoCopy
  320.     set errorCode $errorCodeCopy
  321.     }
  322.     $clientContext notifyEnable
  323.     [.main moduleHdlr] setCurrentContext
  324.     [.main objectHdlr] setCurrentContext
  325. }
  326.  
  327.  
  328. # Open this tree object: display information of the
  329. # children of the current object in the flat view.
  330. #
  331. method TreeNode::open {this} {
  332.     global makeSelectionUpToDate
  333.     set makeSelectionUpToDate 0
  334.     busy {
  335.     set catched 1
  336.     set errorStack ""
  337.     set oldCurrentObj [.main _currentObj]
  338.     if {[[$this browsUiObj] hasChildren]} {
  339.         set catched [catch {set errorStack [.main setCurrentObj $this]} msg]
  340.         if $catched {
  341.         set errorStack $msg
  342.         if [info exists errorInfo] {
  343.             set errorInfoCopy $errorInfo
  344.         } else {
  345.             set errorInfoCopy ""
  346.         }
  347.         if [info exists errorCode] {
  348.             set errorCodeCopy $errorCode
  349.         } else {
  350.             set errorCodeCopy ""
  351.         }
  352.         resetErrorVars
  353.         }
  354.     }
  355.     if {$catched && [isCommand $oldCurrentObj]} {
  356.         set oldCurrentObj [$oldCurrentObj getPreviousNode]
  357.         .main selectionChanged
  358.     }
  359.     set newCurrentObj [.main _currentObj]
  360.     if {$oldCurrentObj != $newCurrentObj} {
  361.         set selectionChanged [expr 1 - [$newCurrentObj selectState]]
  362.         $newCurrentObj config \
  363.         -activeState 1 \
  364.         -selectState 1
  365.         if $selectionChanged {
  366.         .main selectionChanged
  367.         }
  368.  
  369.         for {set parent [$newCurrentObj parent]} \
  370.         {"$parent" != ""} \
  371.         {set parent [$parent parent]} {
  372.         $parent foldState 0
  373.         }
  374.  
  375.         .main insertHistEntry [.main mkHistEntry \
  376.             [[ClientContext::global] currentLevelString] 1 $newCurrentObj]
  377.     }
  378.     }
  379.     set makeSelectionUpToDate 1
  380.  
  381.     if {"$errorStack" != ""} {
  382.     if $catched {
  383.         global errorInfo errorCode
  384.         set errorInfo $errorInfoCopy
  385.         set errorCode $errorCodeCopy
  386.     }
  387.     wmtkerror $errorStack
  388.     }
  389. }
  390.  
  391. method TreeNode::rebuild {this} {
  392.     set browsUiObj [$this browsUiObj]
  393.     if {! [isCommand $browsUiObj]} {
  394.     return
  395.     }
  396.  
  397.     if [$this foldState] {
  398.     return
  399.     }
  400.  
  401.     $this appendChildren 0
  402.     foreach node [$this childSet] {
  403.     $node rebuild
  404.     }
  405. }
  406.  
  407. method TreeNode::remove {this {startIndex -1}} {
  408.     set currentObj [.main _currentObj]
  409.     if {(! [isCommand .main]) || (! [isCommand $currentObj])} return
  410.  
  411.     if [inTree $currentObj $this] {
  412.     set node [$this getPreviousNode 1 $startIndex]
  413.     .main insertHistEntry [.main mkHistEntry \
  414.         [[ClientContext::global] currentLevelString] 1 $node]
  415.     }
  416.  
  417.     if [info exists [$this browsUiObj]::treeNode] {
  418.     unset [$this browsUiObj]::treeNode
  419.     }
  420.  
  421.     $this delete
  422. }
  423.  
  424.  
  425. # Remove all child tree objects.
  426. #
  427. method TreeNode::removeChildren {this} {
  428.     $this makeVisible
  429.  
  430.  
  431.     # Make this one active if the current activated is its (grand)child.
  432.     set currentObj [.main _currentObj]
  433.     if {! [isCommand $currentObj]} return
  434.     if {$currentObj == $this} return
  435.     set found 0
  436.     for {set parent [$currentObj parent]} \
  437.     {"$parent" != ""} \
  438.     {set parent [$parent parent]} {
  439.     if {$parent == $this} {
  440.         set found 1
  441.         break
  442.     }
  443.     }
  444.     if $found {
  445.     $this open
  446.     }
  447. }
  448.  
  449. method TreeNode::update {this} {
  450.     set browsUiObj [$this browsUiObj]
  451.     BrowserProcs::initializeInfo $browsUiObj $this
  452.  
  453.     set name [$browsUiObj getInfo Name]
  454.     if [$browsUiObj typeInLabel] {
  455.     append name ".[$browsUiObj getInfo Type]"
  456.     }
  457.     if [$browsUiObj versionInLabel] {
  458.     append name " (V[$browsUiObj versionNumber])"
  459.     }
  460.     $this config \
  461.     -label $name \
  462.     -hasChildren [$browsUiObj hasChildren]
  463.  
  464.     # Set icons and default foldState
  465.     set uiType "[$browsUiObj getInfo Type]"
  466.     set objType "[$browsUiObj uiClass]"
  467.     set typeSpec [getObjectSpec [.main objectHdlr] "$objType" "$uiType" 0]
  468.     if {"$typeSpec" != ""} {
  469.     set icon [$typeSpec normalIcon]
  470.     set activeIcon [$typeSpec activeIcon]
  471.     set foldState [$this foldState]
  472.     if $foldState {
  473.         set foldState [$typeSpec foldState]
  474.     }
  475.     } else {
  476.     set icon ""
  477.     set activeIcon ""
  478.     set foldState 1
  479.     }
  480.     $this config \
  481.     -icon $icon \
  482.     -activeIcon $activeIcon \
  483.     -foldState $foldState
  484. }
  485.  
  486. # Do not delete this line -- regeneration end marker
  487.  
  488. method TreeNode::addChildLabel {this newChildLabel} {
  489.     [$this childLabelSet] append $newChildLabel
  490.  
  491. }
  492.  
  493. method TreeNode::removeChildLabel {this oldChildLabel} {
  494.     [$this childLabelSet] removeValue $oldChildLabel
  495. }
  496.  
  497. method TreeNode::addOldChild {this newOldChild} {
  498.     [$this oldChildSet] append $newOldChild
  499.  
  500. }
  501.  
  502. method TreeNode::removeOldChild {this oldOldChild} {
  503.     [$this oldChildSet] removeValue $oldOldChild
  504. }
  505.  
  506.