home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / menupartno.tcl < prev    next >
Text File  |  1997-03-14  |  6KB  |  248 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)menupartno.tcl    /main/titanic/4
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)menupartno.tcl    /main/titanic/4   14 Mar 1997 Copyright 1997 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12. # End user added include file section
  13.  
  14. require "custbrowso.tcl"
  15.  
  16. Class MenuPartNode : {BrowsNode CustBrowsObject} {
  17.     method destructor
  18.     constructor
  19.     method displayName
  20.     method infoList
  21.     method updateView
  22.     method open
  23.     method openUnregister
  24.     method check
  25.     method changeDotName
  26.     attribute parentType
  27.     attribute id
  28.     attribute redefined
  29.     attribute ancestor
  30.     attribute predecessor
  31. }
  32.  
  33. method MenuPartNode::destructor {this} {
  34.     # Start destructor user section
  35.     if [isCommand .main] {
  36.         set area [.main editorArea] 
  37.  
  38.         if [isCommand $area] {
  39.             set names [$area getMenuPartNode [$this name]]
  40.             set newNames ""
  41.             foreach j $names {
  42.                 if {$j != $this} {
  43.                     set newNames "$newNames $j"
  44.                 }
  45.             }
  46.             if {![lempty $newNames]} {
  47.                 $area setMenuPartNode [$this name] $newNames
  48.             } else {
  49.                 $area removeMenuPartNode [$this name]
  50.             }
  51.         }
  52.     }
  53.     # End destructor user section
  54.     $this CustBrowsObject::destructor
  55. }
  56.  
  57. constructor MenuPartNode {class this name specification} {
  58.     set this [BrowsNode::constructor $class $this $name]
  59.     set this [CustBrowsObject::constructor $class $this $name]
  60.  
  61.     $this config -activated {%this open} -id $this \
  62.         -conversionSet "WMT_MENUNODE id" 
  63.  
  64.     while {![lempty $specification]} {
  65.         set key [lvarpop specification]
  66.         $this $key [lvarpop specification]
  67.     }
  68.  
  69.     set specification [$this objSpec]
  70.  
  71.     set index [lsearch -exact $specification "label"]
  72.     if {$index != -1} {
  73.         incr index
  74.         $this displayName [lindex $specification $index]
  75.     } 
  76.  
  77.     return $this
  78. }
  79.  
  80. method MenuPartNode::displayName {this args} {
  81.  
  82.     if {$args == ""} {
  83.         return [$this _displayName]
  84.     } else {
  85.         $this _displayName [join $args]
  86.         if { [$this type] != "CustMenuBarButton"} {
  87.             if { [$this parent] != "" } {
  88.                 $this changeDotName [[$this parent] name].menu
  89.             }
  90.         } else {
  91.             $this changeDotName ""
  92.         }
  93.     }
  94. }
  95.  
  96. method MenuPartNode::infoList {this} {
  97.     
  98.     set list [$this CustBrowsObject::infoList]
  99.     lappend list Visible
  100.     if [$this alwaysVisible] {
  101.         lappend list always
  102.     } else {
  103.         set visible ""
  104.         if [lindex [$this visible] 0] {
  105.             lappend visible corporate
  106.         }
  107.         if [lindex [$this visible] 1] {
  108.             lappend visible project
  109.         }
  110.         if [lindex [$this visible] 2] {
  111.             lappend visible config.
  112.         }
  113.         if [lindex [$this visible] 3] {
  114.             lappend visible phase
  115.         }
  116.         if [lindex [$this visible] 4] {
  117.             lappend visible system
  118.         }
  119.         lappend list $visible
  120.     }
  121.     lappend list MenuPath [$this name]
  122.     lappend list index [$this index]
  123.     if {[$this ancestor] != ""} {
  124.         lappend list ancestor [$this ancestor]
  125.     }
  126.     if {[$this predecessor] != ""} {
  127.         lappend list predecessor [$this predecessor]
  128.     }
  129.  
  130.     return $list
  131. }
  132.  
  133. method MenuPartNode::updateView {this} {
  134.  
  135.     set editStatus  ""
  136.     set unregister ""
  137.     if [$this editable] {
  138.         set editStatus "*"
  139.     }
  140.     if [$this unregister] {
  141.         set unregister " <clear>"
  142.     }
  143.  
  144.     $this label "[$this _displayName] $editStatus$unregister"
  145. }
  146.  
  147. method MenuPartNode::open {this} {
  148. }
  149.  
  150. method MenuPartNode::openUnregister {this} {
  151.  
  152.     .main busy TRUE
  153.  
  154.     if {[catch {.main.unregisterDefiner load $this}]} {
  155.         require unregister.tcl
  156.         set definer [UnregisterDialog new .main.unregisterDefiner]
  157.         .main.unregisterDefiner load $this
  158.     }
  159.  
  160.     .main busy FALSE
  161. }
  162.  
  163. method MenuPartNode::check {this newScope newVisible newSpecLevel newParent} {
  164.  
  165.     #check if parent is always available for this object
  166.     set parent $newParent
  167.  
  168.     if {[$parent specLevel] == "user" && $newSpecLevel != "user"} {
  169.         return "An user-defined parent, can not have not-user-defined \
  170.             children"
  171.     }
  172.     
  173.     set parentVisible [$parent visible]
  174.     set objectVisible $newVisible
  175.  
  176.     set index 0
  177.     foreach i $objectVisible {
  178.         if {$i == 1} {
  179.             if {[lindex $parentVisible $index] == 0} {
  180.                 return  "Parent not always available"
  181.             }
  182.         }
  183.         incr index
  184.     }
  185.     
  186.     set parentScope [$parent scope]
  187.     set objectScope $newScope
  188.  
  189.     if {[llength $objectScope] < [llength $parentScope]} {
  190.         return "Parent is not available when child should be present"
  191.     }
  192.  
  193.     # check from current scope not from begin because begin 
  194.     # is (should be) * 
  195.     set area [.main editorArea]
  196.     set curScope [$area _scope]
  197.     set index [llength $curScope]
  198.     foreach i [lrange $objectScope $index end] {
  199.         set x [lindex $parentScope $index]
  200.         if {$x == ""} {
  201.             break
  202.         }
  203.         if {$x != "*" } {
  204.             # if not always on this level, check if parent
  205.             # is on this level when child is.
  206.             if {$i == "*"} {
  207.                 return "Parent not always available"
  208.             }
  209.             foreach y $i {
  210.                 if {[lsearch $x $y] == -1 } {
  211.                     return "Parent not always available"
  212.                 }
  213.             }
  214.         }
  215.         incr index
  216.     }
  217.  
  218.     return ""
  219. }
  220.  
  221. method MenuPartNode::changeDotName {this newDotName} {
  222.  
  223.     set tclName [MenuEdArea::makeTclName [$this displayName]]
  224.     set newObjs ""
  225.  
  226.     foreach i [[$this tree] getMenuPartNode [$this name]] {
  227.         if {$i != $this} {
  228.             set newObjs "$newObjs $i"
  229.         }
  230.     }
  231.     if {![lempty $newObjs]} {
  232.         [$this tree] setMenuPartNode [$this name] $newObjs
  233.     } else {
  234.         [$this tree] removeMenuPartNode [$this name]
  235.     }
  236.     $this name $newDotName.$tclName
  237.     set objs [[$this tree] getMenuPartNode [$this name]]
  238.     set objs "$objs $this"
  239.     [$this tree] setMenuPartNode [$this name] $objs
  240.  
  241.     foreach i [$this childSet] {
  242.         $i changeDotName [$this name].menu
  243.     }
  244. }
  245.  
  246. # Do not delete this line -- regeneration end marker
  247.  
  248.