home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / menutree.tcl < prev    next >
Text File  |  1997-01-13  |  6KB  |  245 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1996
  4. #
  5. #      File:           @(#)menutree.tcl    /main/titanic/3
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)menutree.tcl    /main/titanic/3   13 Jan 1997 Copyright 1996 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12. # End user added include file section
  13.  
  14.  
  15. Class MenuTree : {BrowsTree} {
  16.     constructor
  17.     method destructor
  18.     method dropEvent
  19.     method isDropPossible
  20.     method selectedSet
  21.     method getMenuPartNode
  22.     method setMenuPartNode
  23.     method removeMenuPartNode
  24.     attribute levelsToWrite
  25.     attribute MenuPartNode
  26. }
  27.  
  28. constructor MenuTree {class this name} {
  29.     set this [BrowsTree::constructor $class $this $name]
  30.     $this MenuPartNode [Dictionary new]
  31.     # Start constructor user section
  32.  
  33.     # create popup menu for tree
  34.     TreePopUpMenu new $this.pop -poppedUp {
  35.         %this entrySet [[.main menuHdlr] validPopUpEntrySet]
  36.     }
  37.     # End constructor user section
  38.     return $this
  39. }
  40.  
  41. method MenuTree::destructor {this} {
  42.     # Start destructor user section
  43.     # End destructor user section
  44. }
  45.  
  46. method MenuTree::dropEvent {this droppedObject srcIsDst droppedAfterObject droppedForObject} {
  47.  
  48.     if {$srcIsDst == 0} {
  49.         wmtkerror "Drag & drop between tools is not supported (yet)."
  50.         return
  51.     }
  52.  
  53.     if { $droppedAfterObject == "" && 
  54.         ![$droppedObject isA MenuBarNode] } {
  55.         wmtkerror  "Object not moved, reason: no parent available."
  56.         return
  57.     }
  58.  
  59.     if {![$droppedObject editable]} {
  60.         wmtkerror "Object not moved, reason: object not editable."
  61.         return
  62.     }
  63.  
  64.     set obj $droppedAfterObject
  65.     if [$droppedObject isA MenuBarNode] {
  66.         set newIndex 0
  67.         while {$obj != ""} {
  68.             set newIndex [expr [$obj index] + 1]
  69.             set obj [$obj parent]
  70.         }
  71.     } else {
  72.         if [$obj isA ParentNode] {
  73.             set newIndex 0
  74.         } else {
  75.             set newIndex [expr [$obj index] + 1]
  76.             # find the parent
  77.             while {$obj != "" && (![$obj isA ParentNode] || \
  78.                         [$obj foldState] == 1)} {
  79.                 set obj [$obj parent]
  80.             }
  81.         }
  82.         # is a parent found
  83.         if {$obj == "" } {
  84.             return
  85.         }
  86.     }
  87.  
  88.     if {[$this isDropPossible $droppedObject $obj $droppedForObject \
  89.         $droppedAfterObject] != 1} {
  90.         return
  91.     }
  92.  
  93.     $droppedObject parent $obj
  94.     $droppedObject index $newIndex
  95.     if {$obj != "" } {
  96.                set dotName [$obj name].menu
  97.     } else {
  98.                set dotName ""
  99.     }
  100.  
  101.     # adjust the dotnames from the object and it's children
  102.     $droppedObject changeDotName $dotName
  103.  
  104.     [.main editorArea] isChanged 1
  105.  
  106. }
  107.  
  108. method MenuTree::isDropPossible {this droppedObject parentObject droppedForObject droppedAfterObject} {
  109.     
  110.     if {[ $droppedObject parent] != $parentObject} {
  111.         set parent $parentObject
  112.     } else {
  113.         set parent [$droppedObject parent]
  114.     }
  115.  
  116.     # check if this one is valid
  117.     set err [$droppedObject check [$droppedObject scope] \
  118.         [$droppedObject visible] [$droppedObject specLevel] $parent]
  119.     if {$err != ""} {
  120.         wmtkerror "Object '[$droppedObject displayName]' \
  121.             $err: object not moved."
  122.         return 0
  123.     }
  124.  
  125.     set levelList [$droppedObject specLevel]
  126.  
  127.     # check if all the children can be saved
  128.     set err ""
  129.     foreach i [$this getChildObjects $droppedObject] {
  130.         if {![$i editable]} {
  131.             lappend err "[$i displayName] "
  132.         }
  133.     }
  134.  
  135.     if { $err != "" } {
  136.         wmtkerror "Object '[$droppedObject displayName]' \
  137.             $err not changeable."
  138.         return 0
  139.     }
  140.  
  141.     # handle the drop of an object between object of another level
  142.  
  143.     # check if no object on other levels are beneath this one
  144.     set placeBetween 0
  145.     if {$droppedForObject != "" &&  [$droppedForObject parent] == $parent} {
  146.         if { $parent != ""} {
  147.             set children [$parent childSet]
  148.         } else {
  149.             set children [[.main editorArea] rootSet]
  150.         }
  151.  
  152.         foreach child $children {
  153.             if {[$child index] < [$droppedForObject index]} {
  154.                 continue
  155.             }
  156.             if {[$child specLevel] != [$droppedObject specLevel]} {
  157.                 set placeBetween 1    
  158.             }
  159.         }
  160.     }
  161.  
  162.     if {$placeBetween == 0} {
  163.         $droppedObject ancestor ""
  164.         $droppedObject predecessor ""
  165.         return 1
  166.     }
  167.  
  168.     # check if 
  169.     # - level is the same
  170.     # - ancestor is not defined in a module
  171.     # - ancestor is not defined in the user file
  172.     # - ancestor is present when object is
  173.     # - ancestor has the same parent    
  174.     # - ancestor is not empty
  175.     # - ancestor is not a separator 
  176.  
  177.     set ancestor ""
  178.     if {$droppedForObject != ""} {
  179.         if {[$droppedForObject specLevel] != "user" &&
  180.         [$droppedForObject specLevel] != [$droppedObject specLevel] &&
  181.         [$droppedForObject specModule] == "" &&
  182.         ![$droppedForObject isA SeparatorNode] &&
  183.         [$droppedObject check [$droppedObject scope] \
  184.         [$droppedObject visible] [$droppedObject specLevel] \
  185.         $droppedForObject] == "" && 
  186.         [$droppedForObject parent] == $parent} {
  187.             set ancestor [$droppedForObject name]
  188.         }
  189.     }
  190.  
  191.     # check if predecessor != user and and same parent
  192.     set predecessor ""
  193.     if {$ancestor == "" && $droppedAfterObject != ""} {
  194.         if {[$droppedAfterObject specLevel] != "user" &&
  195.         [$droppedForObject specLevel] != [$droppedObject specLevel] &&
  196.         ![$droppedAfterObject isA SeparatorNode] &&
  197.         [$droppedAfterObject specModule] == "" &&
  198.         [$droppedObject check [$droppedObject scope] \
  199.         [$droppedObject visible] [$droppedObject specLevel] \
  200.         $droppedAfterObject] == "" && 
  201.         [$droppedAfterObject parent] == $parent} {
  202.             set predecessor [$droppedAfterObject name]
  203.         }
  204.     }
  205.  
  206.     if {$ancestor == "" && $predecessor == ""} {
  207.         wmtkerror "Object '[$droppedObject displayName]' can not be \
  208.             placed between these nodes."
  209.         return 0
  210.     } else {
  211.         set idx [string last "." $ancestor]
  212.         set ancestor [string range $ancestor $idx end]
  213.         $droppedObject ancestor $ancestor
  214.         set idx [string last "." $predecessor]
  215.         set predecessor [string range $predecessor $idx end]
  216.         $droppedObject predecessor $predecessor
  217.     }
  218.  
  219.     return 1
  220. }
  221.  
  222. method MenuTree::selectedSet {this args} {
  223.  
  224.     if {$args == ""} {
  225.         return [$this selected]
  226.     } else {
  227.         $this selected [lindex $args 0]
  228.     }
  229. }
  230.  
  231. # Do not delete this line -- regeneration end marker
  232.  
  233. method MenuTree::getMenuPartNode {this dotName} {
  234.     return [[$this MenuPartNode] set $dotName]
  235. }
  236.  
  237. method MenuTree::setMenuPartNode {this dotName newMenuPartNode} {
  238.     [$this MenuPartNode] set $dotName $newMenuPartNode
  239. }
  240.  
  241. method MenuTree::removeMenuPartNode {this dotName} {
  242.     [$this MenuPartNode] unset $dotName
  243. }
  244.  
  245.