home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / menuedarea.tcl < prev    next >
Text File  |  1997-03-14  |  15KB  |  582 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1996
  4. #
  5. #      File:           @(#)menuedarea.tcl    /main/titanic/7
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)menuedarea.tcl    /main/titanic/7   14 Mar 1997 Copyright 1996 Cadre Technologies 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 [list 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 [list 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.     # check if there's an ancestor or a predecessor defined
  179.     if {[$node predecessor] != ""} {
  180.         if { $parent != ""} {
  181.             set predecessor [$parent name].menu[$node predecessor]
  182.         } else {
  183.             set predecessor [$node predecessor]
  184.         }
  185.          foreach foundNode [$this getMenuPartNode $predecessor] {
  186.             set index [expr {[$foundNode index]+1}]
  187.             $node index $index
  188.         }
  189.     }
  190.  
  191.     if {[$node ancestor] != ""} {
  192.         if { $parent != ""} {
  193.             set ancestor [$parent name].menu[$node ancestor]
  194.         } else {
  195.             set ancestor [$node ancestor]
  196.         }
  197.          foreach foundNode [$this getMenuPartNode $ancestor] {
  198.             set index [expr {[$foundNode index]}]
  199.             $node index $index
  200.         }
  201.     }
  202.  
  203.  
  204.     # now check if the objectname already exists
  205.     # if so place the node right under the existing one
  206.     # ( not for separators)
  207.  
  208.     if [$node isA SeparatorNode] {
  209.         # no check and no registration needed
  210.         return $node
  211.     }
  212.  
  213.     set sameNodes "$node"
  214.  
  215.     foreach sameNode [$this getMenuPartNode [$node name]] {
  216.         set sameNodes "$sameNodes $sameNode"
  217.         if {[$node ancestor] == ""  && [$node predecessor] == "" } {
  218.             $node index [ expr {[$sameNode index]+1}]
  219.         }
  220.     }
  221.     $this setMenuPartNode [$node name] $sameNodes
  222.  
  223.     if [$node unregister] {
  224.         $node activated {%this openUnregister}
  225.     }
  226.  
  227.     return $node
  228. }
  229.  
  230. method MenuEdArea::redefineObject {this obj} {
  231.  
  232.     set object [$this CustEdArea::redefineObject $obj]
  233.  
  234.     if [isCommand $object] {
  235.             if {[$object isA ChildNode] && ![$object isA SeparatorNode]}  {
  236.             $object inToolBar [$obj inToolBar]
  237.             $object inPopUpMenu [$obj inPopUpMenu]
  238.             }
  239.         $object updateView
  240.         $this sortArea
  241.     }
  242.  
  243.     return $object
  244. }
  245.  
  246. method MenuEdArea::writeObject {this obj fid} {
  247.  
  248.     #indentation of this function is 4 spaces to make it easier to read
  249.     set list ""
  250.     if [$obj readOnly] {
  251.     lappend list readOnly [$obj readOnly]
  252.     }
  253.     if { [$obj scope] != "" } {
  254.     lappend list scope [$obj scope]
  255.     }
  256.     if {[$obj isA ChildNode] && ![$obj isA SeparatorNode]}  {
  257.     if [$obj inToolBar] {
  258.         lappend list inToolBar [$obj inToolBar]
  259.     }
  260.     if [$obj inPopUpMenu] {
  261.         lappend list inPopUpMenu [$obj inPopUpMenu]
  262.     }
  263.     }
  264.     # build the new TCL name here
  265.     if [$obj isA SeparatorNode] {
  266.     # make u unique name for the separator
  267.     set count [$this separatorCount]
  268.     incr count
  269.     $this separatorCount $count
  270.     if {[$obj parent] == ""} {
  271.         return
  272.     }
  273.     lappend list name [[$obj parent] name].menu.[$this _level]\_$count
  274.     } else {
  275.     lappend list name [$obj name]
  276.     }
  277.     lappend list type [$obj type]
  278.     if { [$obj visible] != "" && [$obj visible] != "1 1 1 1 1"} {
  279.     lappend list visible [$obj visible]
  280.     }
  281.  
  282.     if {[$obj unregister] == 1} {
  283.     lappend list unregister 1
  284.     }
  285.     if { [$obj predecessor] != "" } {
  286.     lappend list predecessor [$obj predecessor]
  287.     }
  288.     if { [$obj ancestor] != "" } {
  289.     lappend list ancestor [$obj ancestor]
  290.     }
  291.     if [$obj isA RadioButtonNode] {
  292.     lappend list arbiter [$obj arbiter]
  293.     }
  294.     # Don't use lappend here to prevent confusion of indentList
  295.     set list "$list objSpec [CustEdArea::indentList [$obj objSpec] 1 1]"
  296.     puts $fid "registerObject [CustEdArea::indentList $list 0 1]"
  297.  
  298.     if {[$obj unregister] == 1} {
  299.     # if this is a unregister object, skip the rest and return
  300.     return
  301.     }
  302.  
  303.     set list ""
  304.     if [$obj isA ParentNode] {
  305.     set name [$obj name].menu
  306.     if { [$obj scope] != "" } {
  307.         lappend list scope [$obj scope]
  308.     }
  309.     lappend list name $name
  310.     lappend list type CustMenu
  311.     if { [$obj visible] != "" && [$obj visible] != "1 1 1 1 1"} {
  312.         lappend list visible [$obj visible]
  313.     }
  314.     if  {[$obj pinnable] == 1} {
  315.         # Don't use lappend here to prevent confusion of indentList
  316.         set list "$list objSpec [CustEdArea::indentList {pinnable 1} 1 1]"
  317.     }
  318.     puts $fid "registerObject [CustEdArea::indentList $list 0 1]"
  319.  
  320.     # now take care of the arbiters
  321.     foreach i [$obj arbiters] {
  322.         set list ""
  323.         set name [$obj name].menu.[MenuEdArea::makeTclName [lindex $i 0]]
  324.         if { [$obj scope] != "" } {
  325.         lappend list scope [$obj scope]
  326.         }
  327.         lappend list name $name
  328.         lappend list type CustMenuArbiter
  329.         if { [$obj visible] != "" } {
  330.         lappend list visible [$obj visible]
  331.         }
  332.         set objSpec [list currentButtonChanged [lindex $i 1]]
  333.         # Don't use lappend here to prevent confusion of indentList
  334.         set list "$list objSpec [CustEdArea::indentList $objSpec 1 1]"
  335.         puts $fid "registerObject [CustEdArea::indentList $list 0 1]"
  336.     }
  337.     }
  338. }
  339.  
  340. method MenuEdArea::getObjects {this} {
  341.  
  342.     set objs [$this rootSet]
  343.     return [concat $objs [$this getChildObjects $objs]]
  344. }
  345.  
  346. method MenuEdArea::clearArea {this} {
  347.     
  348.     foreach obj [$this rootSet] {
  349.         $obj delete
  350.     }
  351.  
  352.     # reinitialise the dictionary
  353.     $this MenuPartNode [Dictionary new]
  354.  
  355.     .main selectionChanged
  356. }
  357.  
  358. proc MenuEdArea::makeTclName {displayName} {
  359.  
  360.     regsub -all "\\\.| |\t" $displayName "" strippedString 
  361.  
  362.     return [string tolower $strippedString]
  363. }
  364.  
  365. method MenuEdArea::getChildObjects {this parentObjs} {
  366.  
  367.     set objs {}
  368.  
  369.     foreach i $parentObjs {
  370.         if [$i hasChildren] {
  371.             set objs [concat $objs [$i childSet]]
  372.             set objs [concat $objs [$this getChildObjects \
  373.                         [$i childSet]]]
  374.         }
  375.     }
  376.     return $objs
  377. }
  378.  
  379. method MenuEdArea::determineObjectType {this objSpec} {
  380.     
  381.     set objType ""
  382.     set menuPartSpec ""
  383.     set name ""
  384.  
  385.     set index [lsearch $objSpec "type"]
  386.     if {$index != -1} {
  387.         incr index
  388.         set objType [lindex $objSpec $index]
  389.     }
  390.  
  391.     if {$objType == "CustMenuPushButton"} {
  392.         return PushButtonNode
  393.     }
  394.     if {$objType == "CustMenuBarButton"} {
  395.         return MenuBarNode
  396.     }
  397.     if {$objType == "CustCascadeButton"} {
  398.         return CascadeNode
  399.     }
  400.     if {$objType == "CustMenuSeparator"} {
  401.         return SeparatorNode
  402.     }
  403.     if {$objType == "CustMenuCheckButton"} {
  404.         return CheckButtonNode
  405.     }
  406.     if {$objType == "CustMenuRadioButton"} {
  407.         return RadioButtonNode
  408.     }
  409.     if {$objType == "CustMenu"} {
  410.         # skip menus
  411.         # if the menu has 'pinnable == 1' , set the parents pinnable
  412.         set pinnable 0
  413.         set menuPartSpec ""
  414.         set index [lsearch $objSpec "objSpec"]
  415.         if {$index != -1} {
  416.             incr index
  417.             set menuPartSpec [lindex $objSpec $index]
  418.         }
  419.         set index [lsearch $menuPartSpec "pinnable"]
  420.         if {$index != -1} {
  421.             incr index
  422.             set pinnable [lindex $menuPartSpec $index]
  423.         }
  424.  
  425.         if {$pinnable == 0} {
  426.             return ""
  427.         }
  428.     
  429.         set index [lsearch $objSpec "name"]
  430.         if {$index != -1} {
  431.             incr index
  432.             set name [lindex $objSpec $index]
  433.         }
  434.         foreach parent [$this getMenuPartNode [getParent $name]] {
  435.             if {$parent != "" && [$parent isA ParentNode] } {
  436.                 $parent pinnable 1
  437.                 break
  438.             }
  439.         }
  440.     }
  441.     if {$objType == "CustMenuArbiter"} {
  442.         # skip menuarbiters
  443.         # registrate the arbiters in the menuparents
  444.         set currentButtonChanged ""
  445.         set menuPartSpec ""
  446.         set index [lsearch $objSpec "objSpec"]
  447.         if {$index != -1} {
  448.             incr index
  449.             set menuPartSpec [lindex $objSpec $index]
  450.         }
  451.         set index [lsearch $menuPartSpec "currentButtonChanged"]
  452.         if {$index != -1} {
  453.             incr index
  454.             set currentButtonChanged [lindex $menuPartSpec $index]
  455.         }
  456.         set index [lsearch $objSpec "name"]
  457.         if {$index != -1} {
  458.             incr index
  459.             set name [lindex $objSpec $index]
  460.         }
  461.  
  462.         set idx [string last "." $name]
  463.         set arbiterName [string range $name [expr {$idx +1}] end]
  464.         set par [string range $name 0 [expr {$idx -1}]]
  465.         set idx [string last "." $par]
  466.         set par [string range $par 0 [expr {$idx -1}]]
  467.  
  468.         foreach parent [$this getMenuPartNode $par] {
  469.             if {$parent != "" && [$parent isA ParentNode]} {
  470.                 set arbiters [$parent arbiters]
  471.                 lappend arbiters "\{$arbiterName\} \
  472.                           \{$currentButtonChanged\}"
  473.                 $parent arbiters $arbiters
  474.                 break
  475.             }
  476.         }
  477.     }
  478.     return ""
  479. }
  480.  
  481. method MenuEdArea::getParentTypeObjects {this} {
  482.  
  483.     set objs [$this getObjects]
  484.     set parentObjs {}
  485.  
  486.     foreach i $objs {
  487.         if { [$i type] == "CustMenuBarButton" || 
  488.              [$i type] == "CustCascadeButton" } {
  489.             # do not count unregister object as parent
  490.             if {[$i unregister] == 0} {
  491.                 lappend parentObjs $i    
  492.             }
  493.         }    
  494.     }
  495.  
  496.     return $parentObjs
  497. }
  498.  
  499. method MenuEdArea::getParent {this child} {
  500.  
  501.     set parent ""
  502.  
  503.     set parentName [getParent [$child name]]
  504.     set parentName [getParent $parentName]
  505.  
  506.     foreach parent [$this getMenuPartNode $parentName] {
  507.             if [$parent isA ParentNode] {
  508.             # do not count unregister object as parent
  509.             if {[$parent unregister] == 0} {
  510.                 break
  511.             }
  512.         }
  513.     }
  514.         return $parent
  515.  
  516.     # because the menu is not shown in the customization 
  517.     # editor interface the child-of-a-menu must be shown
  518.     # in the customization editor as the child-of-the-parent-
  519.     # of-a-menu
  520. }
  521.  
  522. method MenuEdArea::load {this obj} {
  523.  
  524.     if {[$this genericCurName] != "" && [.main permanentReadOnly] == 1} {
  525.         $this loadGeneric $obj
  526.     }
  527.     $this CustEdArea::load $obj
  528. }
  529.  
  530. method MenuEdArea::edit {this obj} {
  531.  
  532.     if {[$this genericCurName] != ""} {
  533.         $this loadGeneric $obj
  534.     }
  535.     $this CustEdArea::edit $obj
  536. }
  537.  
  538. method MenuEdArea::loadGeneric {this obj} {
  539.     
  540.     set curName [$this _curName]
  541.     set curType [$this _curType]
  542.  
  543.     $this isReadOnly 1
  544.     if [isCommand $obj] {
  545.         $this _curName [$this genericCurName]
  546.         $this _curType [[$obj customFile] type]
  547.         if {[llength [$this _path]] > 0} {
  548.             $this read [lindex [$this _path] 0] corporate
  549.         }
  550.         if {[llength [$this _path]] > 1} {
  551.             $this read [lindex [$this _path] 1] project
  552.         }
  553.         if {[llength [$this _path]] > 2} {
  554.             $this read [lindex [$this _path] 2] configuration
  555.         }
  556.         if {[llength [$this _path]] > 3} {
  557.             $this read [lindex [$this _path] 3] phase
  558.         }
  559.         if {[llength [$this _path]] > 4} {
  560.             $this read [lindex [$this _path] 4] system
  561.         }
  562.         $this readUserObjects
  563.     } else {
  564.         # if user is the case, the name of the file is given
  565.         # ~/icase/<obj>.[$this _curType]
  566.         set index [string last "." $obj]
  567.         $this _curName [$this genericCurName]
  568.         $this _curType [string range $obj [expr {$index+1}] end]
  569.         $this _level user
  570.         $this readCorporateObjects
  571.         $this readUserObjects
  572.     }
  573.  
  574.     $this isReadOnly 0
  575.  
  576.     $this _curName $curName
  577.     $this _curType $curType
  578. }
  579.  
  580. # Do not delete this line -- regeneration end marker
  581.  
  582.