home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / menuedarea.tcl < prev    next >
Text File  |  1996-10-24  |  13KB  |  527 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1996
  4. #
  5. #      File:           @(#)menuedarea.tcl    /main/hindenburg/4
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)menuedarea.tcl    /main/hindenburg/4   24 Oct 1996 Copyright 1996 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12.  
  13. require cascadenod.tcl
  14. require checkbutto.tcl
  15. require menubarnod.tcl
  16. require pushbutton.tcl
  17. require radiobutto.tcl
  18. require separatorn.tcl
  19.  
  20. require custmenufi.tcl
  21.  
  22. # End user added include file section
  23.  
  24. require "custedarea.tcl"
  25. require "menutree.tcl"
  26.  
  27. Class MenuEdArea : {MenuTree CustEdArea} {
  28.     method destructor
  29.     constructor
  30.     method newObject
  31.     method deleteObjects
  32.     method createObject
  33.     method redefineObject
  34.     method writeObject
  35.     method getObjects
  36.     method clearArea
  37.     method getChildObjects
  38.     method determineObjectType
  39.     method getParentTypeObjects
  40.     method getParent
  41.     method load
  42.     method edit
  43.     method loadGeneric
  44.     attribute separatorCount
  45.     attribute genericCurName
  46.     attribute parentDefiner
  47.     attribute separatorDefiner
  48.     attribute radioEntryDefiner
  49.     attribute pushEntryDefiner
  50.     attribute checkEntryDefiner
  51. }
  52.  
  53. method MenuEdArea::destructor {this} {
  54.     # Start destructor user section
  55.     # End destructor user section
  56.     $this MenuTree::destructor
  57.     $this CustEdArea::destructor
  58. }
  59.  
  60. constructor MenuEdArea {class this name} {
  61.     set this [MenuTree::constructor $class $this $name]
  62.     set this [CustEdArea::constructor $class $this $name]
  63.  
  64.     $this font "[m4_var get M4_font -context uce]"
  65.     $this rowCount 12
  66.     $this columnCount 60
  67.     $this separatorCount 0
  68.     $this destinationSet "WMT_MENUNODE dropEvent"
  69.  
  70.     global classCount
  71.     $this filter [CustMenuFilter new CustMenuFilter$classCount $this]
  72.     incr classCount
  73.  
  74.     return $this
  75. }
  76.  
  77. method MenuEdArea::newObject {this menuEntryType name parent {edit 0}} {
  78.  
  79.     $this isChanged 1
  80.  
  81.     set user 0
  82.     if {[$this _level] == "user"} {
  83.         set user 1
  84.     }
  85.  
  86.     set dotName [MenuEdArea::makeTclName $name]
  87.     set objSpec "label \\\"$name\\\""
  88.     if { $menuEntryType != "CustMenuBarButton" } {
  89.         # parent is the 'label' of the parent, now search for
  90.         # the parent object
  91.  
  92.         set parentObj ""
  93.     
  94.         foreach i [$this getParentTypeObjects] {
  95.             if {[$i label] == $parent} {
  96.                 set parentObj  $i
  97.             }
  98.         }
  99.         set dotName [$parentObj name].menu.$dotName
  100.         if {$menuEntryType == "CustMenuSeparator"} {
  101.             set objSpec ""
  102.         }
  103.         set parentScope "[$parentObj scope]"
  104.     } else {
  105.         set dotName .$dotName
  106.         set parentScope {}
  107.     }
  108.  
  109.     # the tclName of the menuparententry is set only once,
  110.     # this should be done better, it should also change 
  111.     # when the displayName changes, but this means that
  112.     # there should be a global name change to adjust the children's
  113.     # tclName (object path)
  114.  
  115.     # use as much of the scope of the parent object
  116.     set scope [$this _scope]
  117.     for {set i [llength $scope]} {$i < [llength $parentScope]} {incr i} {
  118.         lappend scope [lindex $parentScope $i]
  119.     }
  120.  
  121.     set obj [$this createObject "displayName    \"$name\"
  122.                 scope    \"$scope\"
  123.                 specLevel    \"[$this _level]\"
  124.                 userDefined $user
  125.                 name    \"$dotName\"
  126.                 type    $menuEntryType
  127.                 visible    {1 1 1 1 1}
  128.                 objSpec    \"$objSpec\""  \
  129.                             [$this _level]]
  130.  
  131.     if $edit {
  132.         $obj open
  133.     }
  134. }
  135.  
  136. method MenuEdArea::deleteObjects {this objs} {
  137.  
  138.     $this isChanged 1
  139.  
  140.     foreach i $objs {
  141.         $i delete
  142.     }
  143.  
  144.     .main selectionChanged
  145. }
  146.  
  147. method MenuEdArea::createObject {this objSpec level} {
  148.  
  149.     set class [$this determineObjectType $objSpec]
  150.     # do not create object if unknown class
  151.     if { $class == "" } {
  152.         return ""
  153.     }
  154.  
  155.     global classCount
  156.     set node [$class new $this.Tree$classCount $objSpec]
  157.     incr classCount
  158.  
  159.     # if invalid scope (level) specified, set scope to corporate
  160.     if {$icaseLevel([llength [$node scope]]) == ""} { 
  161.         $node scope ""
  162.     }
  163.  
  164.     $this adjustCreatedObject $node $level
  165.  
  166.     # put node on the right place
  167.     set parent [$this getParent $node]
  168.  
  169.     if { $parent != ""} {
  170.         $node parent $parent
  171.         set children [$parent childSet]
  172.     } else {
  173.         set children [$this rootSet]
  174.     }
  175.  
  176.     $node updateView
  177.  
  178.     # now check if the objectname already exists
  179.     # if so place the node right under the existing one
  180.     # ( not for separators)
  181.  
  182.     if [$node isA SeparatorNode] {
  183.         # no check and no registration needed
  184.         return $node
  185.     }
  186.  
  187.     set sameNodes "$node"
  188.  
  189.     foreach sameNode [$this getMenuPartNode [$node name]] {
  190.         set sameNodes "$sameNodes $sameNode"
  191.         $node index [ expr {[$sameNode index]+1}]
  192.     }
  193.     $this setMenuPartNode [$node name] $sameNodes
  194.  
  195.     return $node
  196. }
  197.  
  198. method MenuEdArea::redefineObject {this obj} {
  199.  
  200.     set object [$this CustEdArea::redefineObject $obj]
  201.  
  202.     if [isCommand $object] {
  203.             if {[$object isA ChildNode] && ![$object isA SeparatorNode]}  {
  204.             $object inToolBar [$obj inToolBar]
  205.             $object inPopUpMenu [$obj inPopUpMenu]
  206.             }
  207.         $object updateView
  208.         $this sortArea
  209.     }
  210.  
  211.     return $object
  212. }
  213.  
  214. method MenuEdArea::writeObject {this obj fid} {
  215.  
  216.     #indentation of this function is 4 spaces to make it easier to read
  217.     set list ""
  218.     if [$obj readOnly] {
  219.         set list "$list readOnly [$obj readOnly]"
  220.     }
  221.     if { [$obj scope] != "" } {
  222.         set list "$list scope \{[$obj scope]\}"
  223.     }
  224.     if {[$obj isA ChildNode] && ![$obj isA SeparatorNode]}  {
  225.         if [$obj inToolBar] {
  226.             set list "$list inToolBar [$obj inToolBar]"
  227.         }
  228.         if [$obj inPopUpMenu] {
  229.             set list "$list inPopUpMenu [$obj inPopUpMenu]"
  230.     }
  231.     }
  232.     # build the new TCL name here
  233.     if [$obj isA SeparatorNode] {
  234.         # make u unique name for the separator
  235.         set count [$this separatorCount]
  236.         incr count
  237.         $this separatorCount $count
  238.     if {[$obj parent] == ""} {
  239.         return
  240.     }
  241.         set list "$list name [[$obj parent] name].menu.[$this _level]\_$count"
  242.     } else {
  243.     set list "$list name [$obj name]"
  244.     }
  245.     set list "$list type [$obj type]"
  246.     if { [$obj visible] != "" && [$obj visible] != "1 1 1 1 1"} {
  247.         set list "$list visible \{[$obj visible]\}"
  248.     }
  249.     if [$obj isA RadioButtonNode] {
  250.     set list "$list arbiter \"[$obj arbiter]\""
  251.     }
  252.     set list "$list objSpec [CustEdArea::indentList [$obj objSpec] 1 1]"
  253.     puts $fid "registerObject [CustEdArea::indentList $list 0 1]"
  254.  
  255.     set list ""
  256.     if [$obj isA ParentNode] {
  257.         set name [$obj name].menu
  258.         if { [$obj scope] != "" } {
  259.             set list "$list scope \{[$obj scope]\}"
  260.         }
  261.         set list "$list name $name"
  262.         set list "$list type CustMenu"
  263.         if { [$obj visible] != "" } {
  264.             set list "$list visible \{[$obj visible]\}"
  265.         }
  266.         if  {[$obj pinnable] == 1} {
  267.             set list "$list objSpec [CustEdArea::indentList {pinnable 1} 1 1]"
  268.         }
  269.         puts $fid "registerObject [CustEdArea::indentList $list 0 1]"
  270.  
  271.         # now take care of the arbiters
  272.         foreach i [$obj arbiters] {
  273.             set list ""
  274.             set name [MenuEdArea::makeTclName [lindex $i 0]]
  275.             set name [$obj name].menu.$name
  276.             if { [$obj scope] != "" } {
  277.                 set list "$list scope \{[$obj scope]\}"
  278.             }
  279.             set list "$list name $name"
  280.             set list "$list type CustMenuArbiter"
  281.             if { [$obj visible] != "" } {
  282.                 set list "$list visible \{[$obj visible]\}"
  283.             }
  284.             set objSpec "currentButtonChanged  \{[lindex $i 1]\}"
  285.             set list "$list objSpec [CustEdArea::indentList $objSpec 1 1]"
  286.             puts $fid "registerObject [CustEdArea::indentList $list 0 1]"
  287.         }
  288.     }
  289. }
  290.  
  291. method MenuEdArea::getObjects {this} {
  292.  
  293.     set objs [$this rootSet]
  294.     return [concat $objs [$this getChildObjects $objs]]
  295. }
  296.  
  297. method MenuEdArea::clearArea {this} {
  298.     
  299.     foreach obj [$this rootSet] {
  300.         $obj delete
  301.     }
  302.  
  303.     # reinitialise the dictionary
  304.     $this MenuPartNode [Dictionary new]
  305.  
  306.     .main selectionChanged
  307. }
  308.  
  309. proc MenuEdArea::makeTclName {displayName} {
  310.  
  311.     regsub -all "\\\.| |\t" $displayName "" strippedString 
  312.  
  313.     return [string tolower $strippedString]
  314. }
  315.  
  316. method MenuEdArea::getChildObjects {this parentObjs} {
  317.  
  318.     set objs {}
  319.  
  320.     foreach i $parentObjs {
  321.         if [$i hasChildren] {
  322.             set objs [concat $objs [$i childSet]]
  323.             set objs [concat $objs [$this getChildObjects \
  324.                         [$i childSet]]]
  325.         }
  326.     }
  327.     return $objs
  328. }
  329.  
  330. method MenuEdArea::determineObjectType {this objSpec} {
  331.     
  332.     set objType ""
  333.     set menuPartSpec ""
  334.     set name ""
  335.  
  336.     set index [lsearch $objSpec "type"]
  337.     if {$index != -1} {
  338.         incr index
  339.         set objType [lindex $objSpec $index]
  340.     }
  341.  
  342.     if {$objType == "CustMenuPushButton"} {
  343.         return PushButtonNode
  344.     }
  345.     if {$objType == "CustMenuBarButton"} {
  346.         return MenuBarNode
  347.     }
  348.     if {$objType == "CustCascadeButton"} {
  349.         return CascadeNode
  350.     }
  351.     if {$objType == "CustMenuSeparator"} {
  352.         return SeparatorNode
  353.     }
  354.     if {$objType == "CustMenuCheckButton"} {
  355.         return CheckButtonNode
  356.     }
  357.     if {$objType == "CustMenuRadioButton"} {
  358.         return RadioButtonNode
  359.     }
  360.     if {$objType == "CustMenu"} {
  361.         # skip menus
  362.         # if the menu has 'pinnable == 1' , set the parents pinnable
  363.         set pinnable 0
  364.         set menuPartSpec ""
  365.         set index [lsearch $objSpec "objSpec"]
  366.         if {$index != -1} {
  367.             incr index
  368.             set menuPartSpec [lindex $objSpec $index]
  369.         }
  370.         set index [lsearch $menuPartSpec "pinnable"]
  371.         if {$index != -1} {
  372.             incr index
  373.             set pinnable [lindex $menuPartSpec $index]
  374.         }
  375.  
  376.         if {$pinnable == 0} {
  377.             return ""
  378.         }
  379.     
  380.         set index [lsearch $objSpec "name"]
  381.         if {$index != -1} {
  382.             incr index
  383.             set name [lindex $objSpec $index]
  384.         }
  385.         foreach parent [$this getMenuPartNode [getParent $name]] {
  386.             if {$parent != "" && [$parent isA ParentNode] } {
  387.                 $parent pinnable 1
  388.                 break
  389.             }
  390.         }
  391.     }
  392.     if {$objType == "CustMenuArbiter"} {
  393.         # skip menuarbiters
  394.         # registrate the arbiters in the menuparents
  395.         set currentButtonChanged ""
  396.         set menuPartSpec ""
  397.         set index [lsearch $objSpec "objSpec"]
  398.         if {$index != -1} {
  399.             incr index
  400.             set menuPartSpec [lindex $objSpec $index]
  401.         }
  402.         set index [lsearch $menuPartSpec "currentButtonChanged"]
  403.         if {$index != -1} {
  404.             incr index
  405.             set currentButtonChanged [lindex $menuPartSpec $index]
  406.         }
  407.         set index [lsearch $objSpec "name"]
  408.         if {$index != -1} {
  409.             incr index
  410.             set name [lindex $objSpec $index]
  411.         }
  412.  
  413.         set idx [string last "." $name]
  414.         set arbiterName [string range $name [expr {$idx +1}] end]
  415.         set par [string range $name 0 [expr {$idx -1}]]
  416.         set idx [string last "." $par]
  417.         set par [string range $par 0 [expr {$idx -1}]]
  418.  
  419.         foreach parent [$this getMenuPartNode $par] {
  420.             if {$parent != "" && [$parent isA ParentNode]} {
  421.                 set arbiters [$parent arbiters]
  422.                 lappend arbiters "\{$arbiterName\} \
  423.                           \{$currentButtonChanged\}"
  424.                 $parent arbiters $arbiters
  425.                 break
  426.             }
  427.         }
  428.     }
  429.     return ""
  430. }
  431.  
  432. method MenuEdArea::getParentTypeObjects {this} {
  433.  
  434.     set objs [$this getObjects]
  435.     set parentObjs {}
  436.  
  437.     foreach i $objs {
  438.         if { [$i type] == "CustMenuBarButton" || 
  439.              [$i type] == "CustCascadeButton" } {
  440.             lappend parentObjs $i    
  441.         }    
  442.     }
  443.  
  444.     return $parentObjs
  445. }
  446.  
  447. method MenuEdArea::getParent {this child} {
  448.  
  449.     set parent ""
  450.  
  451.     set parentName [getParent [$child name]]
  452.     set parentName [getParent $parentName]
  453.  
  454.     foreach parent [$this getMenuPartNode $parentName] {
  455.             if [$parent isA ParentNode] {
  456.             break
  457.         }
  458.     }
  459.         return $parent
  460.  
  461.     # because the menu is not shown in the customization 
  462.     # editor interface the child-of-a-menu must be shown
  463.     # in the customization editor as the child-of-the-parent-
  464.     # of-a-menu
  465. }
  466.  
  467. method MenuEdArea::load {this obj} {
  468.  
  469.     if {[$this genericCurName] != "" && [.main permanentReadOnly] == 1} {
  470.         $this loadGeneric $obj
  471.     }
  472.     $this CustEdArea::load $obj
  473. }
  474.  
  475. method MenuEdArea::edit {this obj} {
  476.  
  477.     if {[$this genericCurName] != ""} {
  478.         $this loadGeneric $obj
  479.     }
  480.     $this CustEdArea::edit $obj
  481. }
  482.  
  483. method MenuEdArea::loadGeneric {this obj} {
  484.     
  485.     set curName [$this _curName]
  486.     set curType [$this _curType]
  487.  
  488.     $this isReadOnly 1
  489.     if [isCommand $obj] {
  490.         $this _curName [$this genericCurName]
  491.         $this _curType [[$obj customFile] type]
  492.         if {[llength [$this _path]] > 0} {
  493.             $this read [lindex [$this _path] 0] corporate
  494.         }
  495.         if {[llength [$this _path]] > 1} {
  496.             $this read [lindex [$this _path] 1] project
  497.         }
  498.         if {[llength [$this _path]] > 2} {
  499.             $this read [lindex [$this _path] 2] configuration
  500.         }
  501.         if {[llength [$this _path]] > 3} {
  502.             $this read [lindex [$this _path] 3] phase
  503.         }
  504.         if {[llength [$this _path]] > 4} {
  505.             $this read [lindex [$this _path] 4] system
  506.         }
  507.         $this readUserObjects
  508.     } else {
  509.         # if user is the case, the name of the file is given
  510.         # ~/icase/<obj>.[$this _curType]
  511.         set index [string last "." $obj]
  512.         $this _curName [$this genericCurName]
  513.         $this _curType [string range $obj [expr {$index+1}] end]
  514.         $this _level user
  515.         $this readCorporateObjects
  516.         $this readUserObjects
  517.     }
  518.  
  519.     $this isReadOnly 0
  520.  
  521.     $this _curName $curName
  522.     $this _curType $curType
  523. }
  524.  
  525. # Do not delete this line -- regeneration end marker
  526.  
  527.