home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / vbgclasses.tcl < prev    next >
Encoding:
Text File  |  1997-11-10  |  115.7 KB  |  3,860 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. # Copyright (c) 1997 by Cayenne Software, Inc.
  4. #
  5. # This software is furnished under a license and may be used only in
  6. # accordance with the terms of such license and with the inclusion of
  7. # the above copyright notice. This software or any other copies thereof
  8. # may not be provided or otherwise made available to any other person.
  9. # No title to and ownership of the software is hereby transferred.
  10. #
  11. # The information in this software is subject to change without notice
  12. # and should not be construed as a commitment by Cayenne Software, Inc.
  13. #
  14. #---------------------------------------------------------------------------
  15. #
  16. #       File            : vbgclasses.tcl
  17. #       Author          : 
  18. #       Original date   : November 1997
  19. #       Description     : Classes for code generation
  20. #
  21. #---------------------------------------------------------------------------
  22.  
  23.  
  24. #      File:           @(#)vbgclass.tcl    /main/titanic/21
  25.  
  26.  
  27. Class VBGClass : {Object} {
  28.     constructor
  29.     method destructor
  30.     method guiLib
  31.     method hasMain
  32.     method hasExtras
  33.     method baseClass
  34.     method baseType
  35.     method check
  36.     method checkLocal
  37.     method checkLoop
  38.     method checkLoopContainer
  39.     method checkContainer
  40.     method checkLocalContainer
  41.     method generate
  42.     method generateContainer
  43.     attribute bseClass
  44.     attribute bseType
  45.     attribute guiLb
  46.     attribute done
  47.     attribute loop
  48.     attribute hsExtras
  49.     attribute containerErrors
  50.     attribute localContainerErrors
  51. }
  52.  
  53. constructor VBGClass {class this name} {
  54.     set this [Object::constructor $class $this $name]
  55.     # Start constructor user section
  56.     # End constructor user section
  57.     return $this
  58. }
  59.  
  60. method VBGClass::destructor {this} {
  61.     # Start destructor user section
  62.     # End destructor user section
  63. }
  64.  
  65. method VBGClass::guiLib {this} {
  66.         if {[$this guiLb] == ""} {
  67.             if {[$this baseType] != "Class"} {
  68.                  $this guiLb [[[lindex [$this genNodeSet] 0] superClass] getPropertyValue "gui_lib"]        
  69.             }
  70.         } 
  71.         return [$this guiLb] 
  72. }
  73.  
  74. method VBGClass::hasMain {this} {
  75.           switch [$this baseType] {
  76.                  "NodeControl" {
  77.                         return 0
  78.                  }
  79.                  "LeafControl" {
  80.                         return 0
  81.                  }
  82.                  default       {
  83.                         return 1
  84.                  }
  85.             }
  86. }
  87.  
  88. method VBGClass::hasExtras {this} {
  89.       if {[$this hsExtras] == ""} {
  90.             switch [$this baseType] {
  91.                    "NodeControl" {
  92.                           $this hsExtras 0
  93.                    }
  94.                    "LeafControl" {
  95.                           $this hsExtras 0
  96.                    }
  97.                    default       {
  98.                           $this hsExtras 0
  99.         
  100.                           foreach feature [$this dataAttrSet] {
  101.                                if {[$feature isClassFeature]} {
  102.                                     $this hsExtras 1
  103.                                     break
  104.                                }
  105.                           }
  106.  
  107.                           foreach feature [$this operationSet] {
  108.                                if {[$feature isClassFeature] && [$feature getName] != "create"} {
  109.                                     $this hsExtras 1
  110.                                     break
  111.                                }
  112.                           }
  113.                    }
  114.            }
  115.      }
  116.      return [$this hsExtras]
  117. }
  118.  
  119. method VBGClass::baseClass {this} {
  120.         if {[$this bseClass] == ""} {
  121.             if {[$this baseType] == "Class" || [llength [$this genNodeSet]] <= 0} {
  122.                  $this bseClass "Class"
  123.             } else {
  124.                  $this bseClass [[lindex [$this genNodeSet] 0] getSuperClassName]
  125.             }
  126.         } 
  127.         return [$this bseClass] 
  128. }
  129.  
  130. method VBGClass::baseType {this} {
  131.         if {[$this bseType] == ""} {
  132.         if {[$this loop] != 1} {
  133.         $this loop 1
  134.                 if {[llength [$this genNodeSet]] > 0} {
  135.                          set name [[[lindex [$this genNodeSet] 0] superClass] baseType]
  136.                 } else {
  137.                      set name [$this getName]
  138.                 }
  139.         $this loop 0
  140.  
  141.                 switch $name {
  142.                         "Window"    {
  143.                                         $this bseType $name
  144.                         }
  145.                         "NodeControl"   {
  146.                                         $this bseType $name
  147.                         }
  148.                         "LeafControl" {
  149.                                         $this bseType $name
  150.                         }
  151.                         default       {
  152.                                         $this bseType "Class"          
  153.                         }
  154.                 }
  155.         } else {
  156.                 $this bseType "Class"          
  157.         }
  158.         } 
  159.         return [$this bseType] 
  160. }
  161.  
  162. method VBGClass::check {this} {
  163.         set errornr [$this checkLocal]
  164.  
  165.         if {[$this baseClass] == "Class"} {
  166.                    foreach genNode [$this genNodeSet] {
  167.                        incr errornr [$genNode check]
  168.                    }
  169.  
  170.         }
  171.         foreach feature [$this dataAttrSet] {
  172.                 incr errornr [$feature check]
  173.         }
  174.         foreach feature [$this operationSet] {
  175.                 incr errornr [$feature check]
  176.         }
  177.         if {[$this constructor] != ""} {
  178.             incr errornr [[$this constructor] check]
  179.         }
  180.         foreach feature [$this genAssocAttrSet] {
  181.                 incr errornr [$feature check]
  182.         }
  183.         return $errornr
  184. }
  185.  
  186. method VBGClass::checkLocal {this} {
  187.      set errornr [$this checkLoop]
  188.      if {[$this getName] == "Form" || [$this getName] == "MDIForm" ||
  189.          [$this getName] == "LeafControl" || [$this getName] == "NodeControl" ||
  190.          [$this getName] == "Menu" || [$this getName] == "Window"} {
  191.      m4_error $E_RESERVEDWORD [$this getName]
  192.          incr errornr
  193.      }
  194.      return $errornr
  195. }
  196.  
  197. method VBGClass::checkLoop {this} {
  198.      set errornr 0
  199.      if {[$this loop] != 1} {
  200.         $this loop 1
  201.         if {[llength [$this genNodeSet]] > 0} {
  202.                 set errornr [[[lindex [$this genNodeSet] 0] superClass] checkLoop]
  203.         }
  204.         $this loop 0
  205.      } else {
  206.     set errornr 1
  207.      }
  208.      return $errornr
  209. }
  210.  
  211. method VBGClass::checkLoopContainer {this} {
  212.     set errornr 0
  213.     if {[$this done] != 1} {
  214.             if {[$this baseType] == "NodeControl"} {
  215.                   $this done 1
  216.                   foreach assoc [$this genAssocAttrSet] {
  217.              if {![[$assoc ooplType] isA OPBaseType]} {
  218.                        if {[[$assoc ooplType] ooplClass] != ""} {
  219.                               incr errornr [[[$assoc ooplType] ooplClass]  checkLoopContainer]
  220.                        }
  221.                 }
  222.                   }
  223.                   $this done 0
  224.             }
  225.     } else {
  226.         incr errornr 1    
  227.     }
  228.     return $errornr
  229. }
  230.  
  231. method VBGClass::checkContainer {this} {
  232.      if {[$this containerErrors] == ""} {
  233.     set errornr [$this checkLocalContainer]
  234.  
  235.         if {[$this baseType] == "NodeControl" || [$this baseType] == "LeafControl"} {
  236.                if {[$this checkLoopContainer] == 0} {
  237.                  foreach assoc [$this genAssocAttrSet] {
  238.                           incr errornr [$assoc check]
  239.                  }
  240.             }
  241.  
  242.             foreach event [$this operationSet] {
  243.                   set temperr [$event check]
  244.                   incr errornr $temperr
  245.                   incr temperr [$this localContainerErrors]
  246.                   $this localContainerErrors $temperr
  247.             }
  248.     }
  249.         $this containerErrors $errornr
  250.      }
  251.      return [$this containerErrors]
  252. }
  253.  
  254. method VBGClass::checkLocalContainer {this} {
  255.      if {[$this localContainerErrors] == ""} {
  256.          set errornr [$this checkLoop]
  257.          if {[$this checkLoopContainer] > 0} {
  258.             m4_fatal $F_CONTLOOP [$this getName]
  259.             incr errornr 1
  260.          }
  261.          if {[$this baseType] != "NodeControl" && [$this baseType] != "LeafControl"} {
  262.             m4_error $E_NOTACONT [$this getName]
  263.         incr errornr 1
  264.          }
  265.          foreach feature [$this dataAttrSet] {
  266.                  incr errornr [$feature check]
  267.          }
  268.  
  269.         if {[$this getName] == "Form" || [$this getName] == "MDIForm" ||
  270.             [$this getName] == "LeafControl" || [$this getName] == "NodeControl" ||
  271.             [$this getName] == "Menu" || [$this getName] == "Window"} {
  272.         m4_error $E_RESERVEDWORD [$this getName]
  273.             incr errornr
  274.         }
  275.     $this localContainerErrors $errornr
  276.      }
  277.      return [$this localContainerErrors]
  278. }
  279.  
  280. method VBGClass::generate {this tgt} {
  281.     if {[$this checkLocal] != 0} {
  282.         return
  283.     }
  284.         switch [$this baseClass] {
  285.               "Form"    {
  286.                    set unit [VBForm new]
  287.                    $tgt setForm [$this getName] $unit
  288.               }
  289.               "Class"   {
  290.                    set unit [VBClassModule new]
  291.                    $tgt setClassmodule [$this getName] $unit
  292.                    foreach genNode [$this genNodeSet] {
  293.                        $genNode generate $unit
  294.                    }
  295.               }
  296.               "MDIForm" {
  297.                    set unit [VBForm new]
  298.                    $tgt mdiform $unit
  299.               }
  300.         }
  301.  
  302.         set terminate [VBSub new]
  303.         $terminate name "Terminate"
  304.         $terminate access "Private"
  305.         $terminate userCodeFirst 1
  306.         set gcode [TextSection new]
  307.         $terminate gencode $gcode
  308.  
  309.         $unit terminate $terminate
  310.         $unit name [$this getName]
  311.  
  312.         set comment [VBComment new]
  313.         $unit comment $comment
  314.         $comment comment  [$this getPropertyValue "freeText"]
  315.  
  316.         foreach feature [$this dataAttrSet] {
  317.                 $feature generate $unit
  318.         }
  319.         foreach feature [$this operationSet] {
  320.                 $feature generate $unit
  321.         }
  322.         if {[$this constructor] != ""} {
  323.             [$this constructor] generate $unit
  324.         } 
  325.         foreach feature [$this genAssocAttrSet] {
  326.                 $feature generate $unit
  327.         }
  328. }
  329.  
  330. method VBGClass::generateContainer {this roleName number tgt} {
  331.     if {[$this checkLocalContainer] != 0} {
  332.          return
  333.     }
  334.         if {$number != ""} {
  335.             set temp $number
  336.         } else {
  337.             set temp 1       
  338.         }
  339.         for {set i $temp} {$i > 0} {incr i -1} {
  340.             switch [$this baseType] {
  341.                  "NodeControl" {
  342.                         if {[$this baseClass] == "Menu"} {
  343.                              set control [VBMenu new]
  344.                         } else {
  345.                              set control [VBControl new]
  346.                         }
  347.                         foreach assoc [$this genAssocAttrSet] {
  348.                                    $assoc generate $control
  349.                         }
  350.                  } 
  351.                  "LeafControl" {
  352.                         set control [VBControl new]
  353.                         foreach assoc [$this genAssocAttrSet] {
  354.                                    $assoc generate $control
  355.                         }
  356.                  } 
  357.             }
  358.             $control name     $roleName
  359.             $control ofClass  [$this getName]
  360.             $control guiType  [$this baseClass]
  361.             if {[$this guiLib] != ""} {
  362.                $control guiLib   [$this guiLib]
  363.             }
  364.             if {$number != ""} {
  365.                 $control hasIndex 1      
  366.             }
  367.             $tgt addContain $control
  368.         }
  369.  
  370.         foreach event [$this operationSet] {
  371.                 $event generate $control
  372.         }
  373.         
  374. }
  375.  
  376. # Do not delete this line -- regeneration end marker
  377.  
  378. if [isCommand CMClass] {
  379.     Class  VBGClassD : {VBGClass CMClass} {
  380.     }
  381. } else {
  382.     Class VBGClassD : {VBGClass OPClass} {    
  383.     }
  384. }
  385.  
  386. global mostDerivedOOPL ; set mostDerivedOOPL(OPClass) VBGClassD
  387.  
  388. selfPromoter OPClass {this} {
  389.     VBGClassD promote $this
  390. }
  391.  
  392.  
  393. #---------------------------------------------------------------------------
  394. #      File:           @(#)vbgfeature.tcl    /main/titanic/4
  395.  
  396.  
  397. Class VBGFeature : {Object} {
  398.     constructor
  399.     method destructor
  400.     method check
  401.     method checkLocal
  402. }
  403.  
  404. constructor VBGFeature {class this name} {
  405.     set this [Object::constructor $class $this $name]
  406.     # Start constructor user section
  407.     # End constructor user section
  408.     return $this
  409. }
  410.  
  411. method VBGFeature::destructor {this} {
  412.     # Start destructor user section
  413.     # End destructor user section
  414. }
  415.  
  416. method VBGFeature::check {this} {
  417.         set errornr [$this checkLocal]
  418.         return $errornr
  419. }
  420.  
  421. method VBGFeature::checkLocal {this} {
  422.         set errornr 0
  423.         return $errornr
  424. }
  425.  
  426. # Do not delete this line -- regeneration end marker
  427.  
  428. if [isCommand CMFeature] {
  429.     Class  VBGFeatureD : {VBGFeature CMFeature} {
  430.     }
  431. } else {
  432.     Class VBGFeatureD : {VBGFeature OPFeature} {    
  433.     }
  434. }
  435.  
  436. global mostDerivedOOPL ; set mostDerivedOOPL(OPFeature) VBGFeatureD
  437.  
  438. selfPromoter OPFeature {this} {
  439.     VBGFeatureD promote $this
  440. }
  441.  
  442.  
  443. #---------------------------------------------------------------------------
  444. #      File:           @(#)vbginhgrou.tcl    /main/titanic/5
  445.  
  446.  
  447. Class VBGInhGroup : {Object} {
  448.     constructor
  449.     method destructor
  450.     method generate
  451.     method check
  452.     method checkLocal
  453. }
  454.  
  455. constructor VBGInhGroup {class this name} {
  456.     set this [Object::constructor $class $this $name]
  457.     # Start constructor user section
  458.     # End constructor user section
  459.     return $this
  460. }
  461.  
  462. method VBGInhGroup::destructor {this} {
  463.     # Start destructor user section
  464.     # End destructor user section
  465. }
  466.  
  467. method VBGInhGroup::generate {this cl} {
  468.         set type     [VBType new]
  469.         $type name "New [[$this superClass] getName]"
  470.  
  471.         set variable [VBVariable new $type]
  472.         $variable name "[[$this superClass] getName]"
  473.  
  474.         set access [$this inherAccess]
  475.  
  476.         if {$access == ""} {
  477.                 set access "Public"
  478.         }
  479.  
  480.         $variable access $access
  481.  
  482.         $cl addInhervar $variable
  483. }
  484.  
  485. method VBGInhGroup::check {this} {
  486.         set errornr [$this checkLocal]
  487.         return $errornr
  488. }
  489.  
  490. method VBGInhGroup::checkLocal {this} {
  491.         set errornr 0
  492.         return $errornr
  493. }
  494.  
  495. # Do not delete this line -- regeneration end marker
  496.  
  497. if [isCommand CMInhGroup] {
  498.     Class  VBGInhGroupD : {VBGInhGroup CMInhGroup} {
  499.     }
  500. } else {
  501.     Class VBGInhGroupD : {VBGInhGroup OPInhGroup} {    
  502.     }
  503. }
  504.  
  505. global mostDerivedOOPL ; set mostDerivedOOPL(OPInhGroup) VBGInhGroupD
  506.  
  507. selfPromoter OPInhGroup {this} {
  508.     VBGInhGroupD promote $this
  509. }
  510.  
  511.  
  512. #---------------------------------------------------------------------------
  513. #      File:           @(#)vbgparamet.tcl    /main/titanic/5
  514.  
  515.  
  516. Class VBGParameter : {Object} {
  517.     constructor
  518.     method destructor
  519.     method check
  520.     method checkLocal
  521. }
  522.  
  523. constructor VBGParameter {class this name} {
  524.     set this [Object::constructor $class $this $name]
  525.     # Start constructor user section
  526.     # End constructor user section
  527.     return $this
  528. }
  529.  
  530. method VBGParameter::destructor {this} {
  531.     # Start destructor user section
  532.     # End destructor user section
  533. }
  534.  
  535. method VBGParameter::check {this} {
  536.         set errornr [$this checkLocal]
  537.         incr errornr [[$this ooplType] check]
  538.         return $errornr
  539. }
  540.  
  541. method VBGParameter::checkLocal {this} {
  542.         set errornr 0
  543.         if {[$this getPropertyValue "default_value"] != ""} {
  544.             if {[$this getPropertyValue "optional"] != "1"} {
  545.             m4_error $E_HASTOBEOPT [$this getName]
  546.                 incr errornr 
  547.             }
  548.         }
  549.         return $errornr
  550. }
  551.  
  552. # Do not delete this line -- regeneration end marker
  553.  
  554. if [isCommand CMParameter] {
  555.     Class  VBGParameterD : {VBGParameter CMParameter} {
  556.     }
  557. } else {
  558.     Class VBGParameterD : {VBGParameter OPParameter} {    
  559.     }
  560. }
  561.  
  562. global mostDerivedOOPL ; set mostDerivedOOPL(OPParameter) VBGParameterD
  563.  
  564. selfPromoter OPParameter {this} {
  565.     VBGParameterD promote $this
  566. }
  567.  
  568.  
  569. #---------------------------------------------------------------------------
  570. #      File:           @(#)vbginitial.tcl    /main/titanic/3
  571.  
  572.  
  573. Class VBGInitializer : {Object} {
  574.     constructor
  575.     method destructor
  576.     method check
  577.     method checkLocal
  578. }
  579.  
  580. constructor VBGInitializer {class this name} {
  581.     set this [Object::constructor $class $this $name]
  582.     # Start constructor user section
  583.     # End constructor user section
  584.     return $this
  585. }
  586.  
  587. method VBGInitializer::destructor {this} {
  588.     # Start destructor user section
  589.     # End destructor user section
  590. }
  591.  
  592. method VBGInitializer::check {this} {
  593.         set errornr [$this checkLocal]
  594.         return $errornr
  595. }
  596.  
  597. method VBGInitializer::checkLocal {this} {
  598.         set errornr 0
  599.         return $errornr
  600. }
  601.  
  602. # Do not delete this line -- regeneration end marker
  603.  
  604. if [isCommand CMInitializer] {
  605.     Class  VBGInitializerD : {VBGInitializer CMInitializer} {
  606.     }
  607. } else {
  608.     Class VBGInitializerD : {VBGInitializer OPInitializer} {    
  609.     }
  610. }
  611.  
  612. global mostDerivedOOPL ; set mostDerivedOOPL(OPInitializer) VBGInitializerD
  613.  
  614. selfPromoter OPInitializer {this} {
  615.     VBGInitializerD promote $this
  616. }
  617.  
  618.  
  619. #---------------------------------------------------------------------------
  620. #      File:           @(#)vbgtype.tcl    /main/titanic/4
  621.  
  622.  
  623. Class VBGType : {Object} {
  624.     constructor
  625.     method destructor
  626.     method check
  627.     method checkLocal
  628. }
  629.  
  630. constructor VBGType {class this name} {
  631.     set this [Object::constructor $class $this $name]
  632.     # Start constructor user section
  633.     # End constructor user section
  634.     return $this
  635. }
  636.  
  637. method VBGType::destructor {this} {
  638.     # Start destructor user section
  639.     # End destructor user section
  640. }
  641.  
  642. method VBGType::check {this} {
  643.         set errornr [$this checkLocal]
  644.         return $errornr
  645. }
  646.  
  647. method VBGType::checkLocal {this} {
  648.         set errornr 0
  649.         return $errornr
  650. }
  651.  
  652. # Do not delete this line -- regeneration end marker
  653.  
  654. if [isCommand CMType] {
  655.     Class  VBGTypeD : {VBGType CMType} {
  656.     }
  657. } else {
  658.     Class VBGTypeD : {VBGType OPType} {    
  659.     }
  660. }
  661.  
  662. global mostDerivedOOPL ; set mostDerivedOOPL(OPType) VBGTypeD
  663.  
  664. selfPromoter OPType {this} {
  665.     VBGTypeD promote $this
  666. }
  667.  
  668.  
  669. #---------------------------------------------------------------------------
  670. #      File:           @(#)vbgassocge.tcl    /main/titanic/4
  671.  
  672.  
  673. Class VBGAssocGen : {GCObject} {
  674.     constructor
  675.     method destructor
  676.     method hasRead
  677.     method hasWrite
  678.     method hasGet
  679.     method check
  680.     method checkLocal
  681.     method assocattr
  682.     attribute _assocattr
  683. }
  684.  
  685. constructor VBGAssocGen {class this assocattr} {
  686.     set this [GCObject::constructor $class $this]
  687.     $this _assocattr $assocattr
  688.     $assocattr _generator $this
  689.     # Start constructor user section
  690.     # End constructor user section
  691.     return $this
  692. }
  693.  
  694. method VBGAssocGen::destructor {this} {
  695.     # Start destructor user section
  696.     # End destructor user section
  697. }
  698.  
  699. method VBGAssocGen::hasRead {this} {
  700.         set accessList [split [[$this assocattr] getPropertyValue assoc_access] -]
  701.         set accessStr [lindex $accessList 0]
  702.         if {$accessStr == ""} {
  703.                 set accessStr "Public"
  704.         }
  705.         return $accessStr
  706. }
  707.  
  708. method VBGAssocGen::hasWrite {this} {
  709.         set accessList [split [[$this assocattr] getPropertyValue assoc_access] -]
  710.         set accessStr [lindex $accessList 1]
  711.         if {$accessStr == ""} {
  712.                 set accessStr "Public"
  713.         }
  714.         return $accessStr
  715. }
  716.  
  717. method VBGAssocGen::hasGet {this self} {
  718.     set rd [$this hasRead]
  719.     if {$self} {
  720.         if {$rd == "None"} {
  721.             return 0
  722.         } 
  723.     } else {
  724.         if {$rd == "None" || $rd == "Private"} {
  725.             return 0
  726.         } 
  727.     }
  728.     return 1
  729. }
  730.  
  731. method VBGAssocGen::check {this} {
  732.         set errornr [$this checkLocal]
  733.         return $errornr
  734. }
  735.  
  736. method VBGAssocGen::checkLocal {this} {
  737.         set errornr 0
  738.         return $errornr
  739. }
  740.  
  741. # Do not delete this line -- regeneration end marker
  742.  
  743. method VBGAssocGen::assocattr {this args} {
  744.     if {$args == ""} {
  745.         return [$this _assocattr]
  746.     }
  747.     set ref [$this _assocattr]
  748.     if {$ref != ""} {
  749.         $ref _generator ""
  750.     }
  751.     set obj [lindex $args 0]
  752.     if {$obj != ""} {
  753.         $obj _generator $this
  754.     }
  755.     $this _assocattr $obj
  756. }
  757.  
  758.  
  759.  
  760. #---------------------------------------------------------------------------
  761. #      File:           @(#)vbgclassen.tcl    /main/titanic/4
  762.  
  763.  
  764. Class VBGClassEnum : {VBGClass} {
  765.     constructor
  766.     method destructor
  767.     method baseClass
  768.     method baseType
  769.     method check
  770.     method checkLocal
  771.     method hasMain
  772.     method hasExtras
  773.     method generate
  774. }
  775.  
  776. constructor VBGClassEnum {class this name} {
  777.     set this [VBGClass::constructor $class $this $name]
  778.     # Start constructor user section
  779.     # End constructor user section
  780.     return $this
  781. }
  782.  
  783. method VBGClassEnum::destructor {this} {
  784.     # Start destructor user section
  785.     # End destructor user section
  786. }
  787.  
  788. method VBGClassEnum::baseClass {this} {
  789.         if {[$this bseClass] == ""} { 
  790.             $this bseClass "Enum"
  791.         }
  792.         return [$this bseClass] 
  793. }
  794.  
  795. method VBGClassEnum::baseType {this} {
  796.         if {[$this bseType] == ""} { 
  797.             $this bseType "Class"
  798.         }
  799.         return [$this bseType] 
  800. }
  801.  
  802. method VBGClassEnum::check {this} {
  803.         set errornr [$this checkLocal]
  804.         foreach feature [$this dataAttrSet] {
  805.                 incr errornr [$feature check]
  806.         }
  807.         return $errornr
  808. }
  809.  
  810. method VBGClassEnum::checkLocal {this} {
  811.         set errornr 0
  812.         return $errornr
  813. }
  814.  
  815. method VBGClassEnum::hasMain {this} {
  816.         return 0 
  817. }
  818.  
  819. method VBGClassEnum::hasExtras {this} {
  820.         return 1
  821. }
  822.  
  823. method VBGClassEnum::generate {this tgt} {
  824.     set enummodule [VBEnumModule new]
  825.         $enummodule name [$this getName]
  826.  
  827.         foreach enum [$this dataAttrSet] {
  828.               $enum generate $enummodule
  829.         }
  830.         $tgt setModule [$this getName] $enummodule
  831. }
  832.  
  833. # Do not delete this line -- regeneration end marker
  834.  
  835. if [isCommand CMClassEnum] {
  836.     Class  VBGClassEnumD : {VBGClassEnum CMClassEnum} {
  837.     }
  838. } else {
  839.     Class VBGClassEnumD : {VBGClassEnum OPClassEnum} {    
  840.     }
  841. }
  842.  
  843. global mostDerivedOOPL ; set mostDerivedOOPL(OPClassEnum) VBGClassEnumD
  844.  
  845. selfPromoter OPClassEnum {this} {
  846.     VBGClassEnumD promote $this
  847. }
  848.  
  849.  
  850. #---------------------------------------------------------------------------
  851. #      File:           @(#)vbgclassge.tcl    /main/titanic/3
  852.  
  853.  
  854. Class VBGClassGenericTypeDef : {VBGClass} {
  855.     constructor
  856.     method destructor
  857. }
  858.  
  859. constructor VBGClassGenericTypeDef {class this name} {
  860.     set this [VBGClass::constructor $class $this $name]
  861.     # Start constructor user section
  862.     # End constructor user section
  863.     return $this
  864. }
  865.  
  866. method VBGClassGenericTypeDef::destructor {this} {
  867.     # Start destructor user section
  868.     # End destructor user section
  869. }
  870.  
  871. # Do not delete this line -- regeneration end marker
  872.  
  873. if [isCommand CMClassGenericTypeDef] {
  874.     Class  VBGClassGenericTypeDefD : {VBGClassGenericTypeDef CMClassGenericTypeDef} {
  875.     }
  876. } else {
  877.     Class VBGClassGenericTypeDefD : {VBGClassGenericTypeDef OPClassGenericTypeDef} {    
  878.     }
  879. }
  880.  
  881. global mostDerivedOOPL ; set mostDerivedOOPL(OPClassGenericTypeDef) VBGClassGenericTypeDefD
  882.  
  883. selfPromoter OPClassGenericTypeDef {this} {
  884.     VBGClassGenericTypeDefD promote $this
  885. }
  886.  
  887.  
  888. #---------------------------------------------------------------------------
  889. #      File:           @(#)vbgclasstd.tcl    /main/titanic/3
  890.  
  891.  
  892. Class VBGClassTDef : {VBGClass} {
  893.     constructor
  894.     method destructor
  895. }
  896.  
  897. constructor VBGClassTDef {class this name} {
  898.     set this [VBGClass::constructor $class $this $name]
  899.     # Start constructor user section
  900.     # End constructor user section
  901.     return $this
  902. }
  903.  
  904. method VBGClassTDef::destructor {this} {
  905.     # Start destructor user section
  906.     # End destructor user section
  907. }
  908.  
  909. # Do not delete this line -- regeneration end marker
  910.  
  911. if [isCommand CMClassTDef] {
  912.     Class  VBGClassTDefD : {VBGClassTDef CMClassTDef} {
  913.     }
  914. } else {
  915.     Class VBGClassTDefD : {VBGClassTDef OPClassTDef} {    
  916.     }
  917. }
  918.  
  919. global mostDerivedOOPL ; set mostDerivedOOPL(OPClassTDef) VBGClassTDefD
  920.  
  921. selfPromoter OPClassTDef {this} {
  922.     VBGClassTDefD promote $this
  923. }
  924.  
  925.  
  926. #---------------------------------------------------------------------------
  927. #      File:           @(#)vbglinkcla.tcl    /main/titanic/3
  928.  
  929.  
  930. Class VBGLinkClass : {VBGClass} {
  931.     constructor
  932.     method destructor
  933. }
  934.  
  935. constructor VBGLinkClass {class this name} {
  936.     set this [VBGClass::constructor $class $this $name]
  937.     # Start constructor user section
  938.     # End constructor user section
  939.     return $this
  940. }
  941.  
  942. method VBGLinkClass::destructor {this} {
  943.     # Start destructor user section
  944.     # End destructor user section
  945. }
  946.  
  947. # Do not delete this line -- regeneration end marker
  948.  
  949. if [isCommand CMLinkClass] {
  950.     Class  VBGLinkClassD : {VBGLinkClass CMLinkClass} {
  951.     }
  952. } else {
  953.     Class VBGLinkClassD : {VBGLinkClass OPLinkClass} {    
  954.     }
  955. }
  956.  
  957. global mostDerivedOOPL ; set mostDerivedOOPL(OPLinkClass) VBGLinkClassD
  958.  
  959. selfPromoter OPLinkClass {this} {
  960.     VBGLinkClassD promote $this
  961. }
  962.  
  963.  
  964. #---------------------------------------------------------------------------
  965. #      File:           @(#)vbgattribu.tcl    /main/titanic/3
  966.  
  967.  
  968. Class VBGAttribute : {VBGFeature} {
  969.     constructor
  970.     method destructor
  971. }
  972.  
  973. constructor VBGAttribute {class this name} {
  974.     set this [VBGFeature::constructor $class $this $name]
  975.     # Start constructor user section
  976.     # End constructor user section
  977.     return $this
  978. }
  979.  
  980. method VBGAttribute::destructor {this} {
  981.     # Start destructor user section
  982.     # End destructor user section
  983. }
  984.  
  985. # Do not delete this line -- regeneration end marker
  986.  
  987. if [isCommand CMAttribute] {
  988.     Class  VBGAttributeD : {VBGAttribute CMAttribute} {
  989.     }
  990. } else {
  991.     Class VBGAttributeD : {VBGAttribute OPAttribute} {    
  992.     }
  993. }
  994.  
  995. global mostDerivedOOPL ; set mostDerivedOOPL(OPAttribute) VBGAttributeD
  996.  
  997. selfPromoter OPAttribute {this} {
  998.     VBGAttributeD promote $this
  999. }
  1000.  
  1001.  
  1002. #---------------------------------------------------------------------------
  1003. #      File:           @(#)vbgconstru.tcl    /main/titanic/6
  1004.  
  1005.  
  1006. Class VBGConstructor : {VBGFeature} {
  1007.     constructor
  1008.     method destructor
  1009.     method check
  1010.     method checkLocal
  1011.     method generate
  1012. }
  1013.  
  1014. constructor VBGConstructor {class this name} {
  1015.     set this [VBGFeature::constructor $class $this $name]
  1016.     # Start constructor user section
  1017.     # End constructor user section
  1018.     return $this
  1019. }
  1020.  
  1021. method VBGConstructor::destructor {this} {
  1022.     # Start destructor user section
  1023.     # End destructor user section
  1024. }
  1025.  
  1026. method VBGConstructor::check {this} {
  1027.         set errornr [$this checkLocal]
  1028.  
  1029.         foreach param [[$this ooplClass] creationParamSet] {
  1030.                 incr errornr [$param check]
  1031.         }
  1032.  
  1033.         foreach initializer [$this initializerSet] {
  1034.                 incr errornr [$initializer check]
  1035.         }
  1036.  
  1037.         return $errornr
  1038. }
  1039.  
  1040. method VBGConstructor::checkLocal {this} {
  1041.         set errornr 0
  1042.         if {[$this getPropertyValue "method_access"] == "Protected"} {
  1043.         m4_warning $W_METVISCHANGE "\$[$this getName]"
  1044.                 incr errornr 1
  1045.         }
  1046.         return $errornr
  1047. }
  1048.  
  1049. method VBGConstructor::generate {this cl} {
  1050.         $this checkLocal
  1051.         set ctor [VBSub new]
  1052.         set comment [VBComment new]
  1053.         $ctor comment $comment
  1054.         $comment comment  [$this getPropertyValue "freeText"]
  1055.  
  1056.         $ctor name "Constructor"                                
  1057.         $ctor access [$this getPropertyValue "method_access"]
  1058.         if {[$ctor access] == ""} {
  1059.                $ctor access "Public"
  1060.         }
  1061.         if {[$ctor access] == "Protected"} {
  1062.                $ctor access "Public"
  1063.         }
  1064.  
  1065.         set gencode [TextSection new]
  1066.         $ctor gencode $gencode    
  1067.  
  1068.         foreach attrib [[$this ooplClass] dataAttrSet] {
  1069.                 $attrib generateSetDefault $ctor
  1070.         }
  1071.  
  1072.         foreach param [[$this ooplClass] creationParamSet] {
  1073.                 $param generate $ctor
  1074.         }
  1075.  
  1076.         foreach initializer [$this initializerSet] {
  1077.                 $initializer generate $ctor
  1078.         }
  1079.     
  1080.         $cl constructor $ctor
  1081. }
  1082.  
  1083. # Do not delete this line -- regeneration end marker
  1084.  
  1085. if [isCommand CMConstructor] {
  1086.     Class  VBGConstructorD : {VBGConstructor CMConstructor} {
  1087.     }
  1088. } else {
  1089.     Class VBGConstructorD : {VBGConstructor OPConstructor} {    
  1090.     }
  1091. }
  1092.  
  1093. global mostDerivedOOPL ; set mostDerivedOOPL(OPConstructor) VBGConstructorD
  1094.  
  1095. selfPromoter OPConstructor {this} {
  1096.     VBGConstructorD promote $this
  1097. }
  1098.  
  1099.  
  1100. #---------------------------------------------------------------------------
  1101. #      File:           @(#)vbgoperati.tcl    /main/titanic/15
  1102.  
  1103.  
  1104. Class VBGOperation : {VBGFeature} {
  1105.     constructor
  1106.     method destructor
  1107.     method getParamSet
  1108.     method getReturnType
  1109.     method isEvent
  1110.     method check
  1111.     method checkLocal
  1112.     method dblEvent
  1113.     method dblGlobproc
  1114.     method dblUserproc
  1115.     method generate
  1116.     attribute isEv
  1117.     attribute PSet
  1118.     attribute RType
  1119. }
  1120.  
  1121. constructor VBGOperation {class this name} {
  1122.     set this [VBGFeature::constructor $class $this $name]
  1123.     # Start constructor user section
  1124.     # End constructor user section
  1125.     return $this
  1126. }
  1127.  
  1128. method VBGOperation::destructor {this} {
  1129.     # Start destructor user section
  1130.     # End destructor user section
  1131. }
  1132.  
  1133. method VBGOperation::getParamSet {this} {
  1134.     if {[$this PSet] == ""} {
  1135.         $this PSet [$this parameterSet]
  1136.         if {[$this getPropertyValue "is_event"] == ""} {
  1137.             if {[llength [[$this ooplClass] genNodeSet]] > 0} {
  1138.                 foreach sup [[$this ooplClass] genNodeSet] {
  1139.                        foreach feature [[$sup superClass] operationSet] {
  1140.                        if {[$feature getName] == [$this getName]} {
  1141.                         $this PSet [$feature getParamSet]
  1142.                         m4_message $M_USEPARAM [$this getName] [[$this ooplClass] baseClass] [[$this ooplClass] getName]
  1143.                          break    
  1144.                        }
  1145.                    }
  1146.                 }
  1147.             }
  1148.         }
  1149.     }
  1150.     return [$this PSet]
  1151. }
  1152.  
  1153. method VBGOperation::getReturnType {this} {
  1154.     if {[$this RType] == ""} {
  1155.         $this RType [$this ooplType]
  1156.         if {[$this getPropertyValue "is_event"] == ""} {
  1157.             if {[llength [[$this ooplClass] genNodeSet]] > 0} {
  1158.                 foreach sup [[$this ooplClass] genNodeSet] {
  1159.                        foreach feature [[$sup superClass] operationSet] {
  1160.                        if {[$feature getName] == [$this getName]} {
  1161.                         $this RType [$feature getReturnType]
  1162.                          break    
  1163.                        }
  1164.                    }
  1165.                 }
  1166.             }
  1167.         }
  1168.     }
  1169.     return [$this RType]
  1170. }
  1171.  
  1172. method VBGOperation::isEvent {this} {
  1173.     if {[$this isEv] == ""} {
  1174.            switch [$this getPropertyValue "is_event"] {
  1175.                "Yes" {
  1176.             $this isEv 1
  1177.         }
  1178.                "No" {
  1179.             $this isEv 0
  1180.         }
  1181.         default {
  1182.             $this isEv 0
  1183.             if {[llength [[$this ooplClass] genNodeSet]] > 0} {
  1184.                 foreach sup [[$this ooplClass] genNodeSet] {
  1185.                           foreach feature [[$sup superClass] operationSet] {
  1186.                        if {[$feature getName] == [$this getName]} {
  1187.                                 $this isEv [$feature isEvent] 
  1188.                          break    
  1189.                        }
  1190.                    }
  1191.                 }
  1192.             }
  1193.         }
  1194.        }
  1195.     }
  1196.     return [$this isEv]
  1197. }
  1198.  
  1199. method VBGOperation::check {this} {
  1200.         set errornr [$this checkLocal]
  1201.  
  1202.         incr errornr [[$this getReturnType] check]
  1203.  
  1204.         foreach param [$this getParamSet] {
  1205.                 incr errornr [$param check]
  1206.         }
  1207.     return $errornr
  1208. }
  1209.  
  1210. method VBGOperation::checkLocal {this} {
  1211.         set errornr 0
  1212.  
  1213.         if {[[$this ooplClass] baseType] == "NodeControl" || [[$this ooplClass] baseType] == "LeafControl"} {
  1214.         if {[$this isEvent] != 1} {
  1215.                m4_error $E_CANTCONTMETH [[$this ooplClass] getName]
  1216.            incr errornr 1 
  1217.             } else {
  1218.                  if {[$this dblEvent [$this getName]]} {
  1219.                        m4_error $E_EVENTDBDEF [$this getName] [[$this ooplClass] getName]
  1220.                       incr errornr 1 
  1221.                  }
  1222.         }
  1223.     }
  1224.         if {[[$this ooplClass] baseType] == "Class"} {
  1225.         if {[$this isEvent] == 1} {
  1226.                m4_error $E_CANTCONTEVENT [[$this ooplClass] getName]
  1227.            incr errornr 1 
  1228.             } else { 
  1229.                if {[$this isClassFeature]} {
  1230.                     if {[$this dblGlobproc [$this getName]]} {
  1231.                        m4_error $E_METHODDBDEF [$this getName] [[$this ooplClass] getName]
  1232.                       incr errornr 1 
  1233.                     }
  1234.                } else {
  1235.                     if {[$this dblUserproc [$this getName]]} {
  1236.                        m4_error $E_METHODDBDEF [$this getName] [[$this ooplClass] getName]
  1237.                       incr errornr 1 
  1238.                     }
  1239.            }
  1240.         }
  1241.     }
  1242.         if {[[$this ooplClass] baseType] == "Window"} {
  1243.         if {[$this isEvent] == 1} {
  1244.                  if {[$this dblEvent [$this getName]]} {
  1245.                        m4_error $E_EVENTDBDEF [$this getName] [[$this ooplClass] getName]
  1246.                       incr errornr 1 
  1247.                  }
  1248.             } else { 
  1249.                if {[$this isClassFeature]} {
  1250.                     if {[$this dblGlobproc [$this getName]]} {
  1251.                        m4_error $E_METHODDBDEF [$this getName] [[$this ooplClass] getName]
  1252.                       incr errornr 1 
  1253.                     }
  1254.                } else {
  1255.                     if {[$this dblUserproc [$this getName]]} {
  1256.                        m4_error $E_METHODDBDEF [$this getName] [[$this ooplClass] getName]
  1257.                       incr errornr 1 
  1258.                     }
  1259.            }
  1260.         }
  1261.     }
  1262.         if {[$this getPropertyValue "method_access"] == "Protected"} {
  1263.         m4_warning $W_METVISCHANGE [$this getName]
  1264.         }
  1265.         return $errornr
  1266. }
  1267.  
  1268. method VBGOperation::dblEvent {this name} {
  1269.     set nr 0
  1270.         foreach feature [[$this ooplClass] operationSet] {
  1271.        if {[$feature getName] == $name && [$feature isEvent] == 1} {
  1272.                 incr nr 1
  1273.        }
  1274.         }
  1275.     if {$nr > 1} {
  1276.         return 1
  1277.     } 
  1278.     return 0
  1279. }
  1280.  
  1281. method VBGOperation::dblGlobproc {this name} {
  1282.     set nr 0
  1283.         foreach feature [[$this ooplClass] operationSet] {
  1284.        if {[$feature getName] == $name && [$feature isClassFeature] && [$feature isEvent] != 1} {
  1285.                 incr nr 1
  1286.        }
  1287.         }
  1288.     if {$nr > 1} {
  1289.         return 1
  1290.     } 
  1291.     return 0
  1292. }
  1293.  
  1294. method VBGOperation::dblUserproc {this name} {
  1295.     set nr 0
  1296.         foreach feature [[$this ooplClass] operationSet] {
  1297.        if {[$feature getName] == $name && ![$feature isClassFeature] && [$feature isEvent] != 1} {
  1298.                 incr nr 1
  1299.        }
  1300.         }
  1301.     if {$nr > 1} {
  1302.         return 1
  1303.     } 
  1304.     return 0
  1305. }
  1306.  
  1307. method VBGOperation::generate {this cl} {
  1308.     if {[$this checkLocal] > 0} {
  1309.         return
  1310.     }
  1311.         switch [[$this ooplClass] baseType] {
  1312.                "NodeControl" {
  1313.                            set oper [VBEvent new]
  1314.                            $oper name [$this getName]
  1315.                            $cl setEvent [$oper name] $oper
  1316.                            $cl addSevent $oper
  1317.                }
  1318.                "LeafControl" {
  1319.                            set oper [VBEvent new]
  1320.                            $oper name [$this getName]
  1321.                            $cl setEvent [$oper name] $oper
  1322.                            $cl addSevent $oper
  1323.                }
  1324.                "Class"       {
  1325.                            set returntype [[$this getReturnType] generate]
  1326.                            if {[$returntype name] != ""} {
  1327.                                    set oper [VBFunction new $returntype]                 
  1328.                                    $oper name [$this getName]
  1329.  
  1330.                                    if {[$this isClassFeature]} {
  1331.                                         $cl setGlobproc [$oper name] $oper
  1332.                                         $cl addGlobSproc $oper
  1333.                                    } else {
  1334.                                         $cl addUserSproc $oper
  1335.                                         $cl setUserproc [$oper name] $oper
  1336.                                    }
  1337.                            } else {
  1338.                                    set oper [VBSub new]
  1339.                                    $oper name [$this getName]
  1340.  
  1341.                                    if {[$this getName] == "create" && [$this isClassFeature]} {
  1342.                                           $oper name "Constructor"
  1343.                                           $cl constructor $oper
  1344.                                    } else {
  1345.                                            if {[$this isClassFeature]} {
  1346.                                                $cl setGlobproc [$oper name] $oper
  1347.                                                $cl addGlobSproc $oper
  1348.                                            } else {
  1349.                                                $cl addUserSproc $oper
  1350.                                                $cl setUserproc [$oper name] $oper
  1351.                                            }
  1352.                                    }
  1353.                            }
  1354.                }
  1355.                "Window"      {
  1356.                       if {[$this isEvent] == 1} {
  1357.                                    set oper [VBEvent new]
  1358.                                    $oper name [$this getName]
  1359.                                    $cl setEvent [$oper name] $oper
  1360.                                    $cl addSevent $oper
  1361.                       } else {
  1362.                            set returntype [[$this getReturnType] generate]
  1363.                            if {[$returntype name] != ""} {
  1364.                                    set oper [VBFunction new $returntype]                 
  1365.                                    $oper name [$this getName]
  1366.  
  1367.                                    if {[$this isClassFeature]} {
  1368.                                         $cl setGlobproc [$oper name] $oper
  1369.                                         $cl addGlobSproc $oper
  1370.                                    } else {
  1371.                                         $cl addUserSproc $oper
  1372.                                         $cl setUserproc [$oper name] $oper
  1373.                                    }
  1374.                            } else {
  1375.                                    set oper [VBSub new]
  1376.                                    $oper name [$this getName]
  1377.  
  1378.                                    if {[$this getName] == "create" && [$this isClassFeature]} {
  1379.                                           $oper name "Constructor"
  1380.                                           $cl constructor $oper
  1381.                                    } else {
  1382.                                            if {[$this isClassFeature]} {
  1383.                                               if {[$cl getGlobproc [$oper name]] == ""} {
  1384.                                                    $cl setGlobproc [$oper name] $oper
  1385.                                                    $cl addGlobSproc $oper
  1386.                                               }
  1387.                                            } else {
  1388.                                               if {[$cl getUserproc [$oper name]] == ""} {
  1389.                                                     $cl addUserSproc $oper
  1390.                                                    $cl setUserproc [$oper name] $oper
  1391.                                               }
  1392.                                            }
  1393.                                    }
  1394.                            }
  1395.                       }
  1396.                }
  1397.         }
  1398.  
  1399.         $oper access [$this getPropertyValue "method_access"]
  1400.         $oper hasUserSection 0                                          
  1401.  
  1402.         if {[$oper access] == ""} {
  1403.                  $oper access "Public"
  1404.         }
  1405.         if {[$oper access] == "Protected"} {
  1406.                $oper access "Public"
  1407.         }
  1408.  
  1409.         set comment [VBComment new]
  1410.         $oper comment $comment
  1411.         $comment comment  [$this getPropertyValue "freeText"]
  1412.  
  1413.         foreach param [$this getParamSet] {
  1414.                 $param generate $oper
  1415.         }
  1416. }
  1417.  
  1418. # Do not delete this line -- regeneration end marker
  1419.  
  1420. if [isCommand CMOperation] {
  1421.     Class  VBGOperationD : {VBGOperation CMOperation} {
  1422.     }
  1423. } else {
  1424.     Class VBGOperationD : {VBGOperation OPOperation} {    
  1425.     }
  1426. }
  1427.  
  1428. global mostDerivedOOPL ; set mostDerivedOOPL(OPOperation) VBGOperationD
  1429.  
  1430. selfPromoter OPOperation {this} {
  1431.     VBGOperationD promote $this
  1432. }
  1433.  
  1434.  
  1435. #---------------------------------------------------------------------------
  1436. #      File:           @(#)vbgctorpar.tcl    /main/titanic/11
  1437.  
  1438.  
  1439. Class VBGCtorParameter : {VBGParameter} {
  1440.     constructor
  1441.     method destructor
  1442.     method generate
  1443. }
  1444.  
  1445. constructor VBGCtorParameter {class this name} {
  1446.     set this [VBGParameter::constructor $class $this $name]
  1447.     # Start constructor user section
  1448.     # End constructor user section
  1449.     return $this
  1450. }
  1451.  
  1452. method VBGCtorParameter::destructor {this} {
  1453.     # Start destructor user section
  1454.     # End destructor user section
  1455. }
  1456.  
  1457. method VBGCtorParameter::generate {this method} {
  1458.         if {[$this checkLocal] != 0} {
  1459.             return
  1460.         }
  1461.  
  1462.         if {[$this attrib] != ""} {
  1463.            if {[[$this attrib] isClassFeature]} {
  1464.                return
  1465.            }
  1466.         }  
  1467.         set param [VBArgument new [[$this ooplType] generate]]
  1468.  
  1469.         if {[$this initializer] != ""} {
  1470.        if {[[$this initializer] isA OPQualInitializer]} {
  1471.         return
  1472.        }
  1473.            if {[[$this initializer] isA OPAssocInitializer]} { 
  1474.           if {[[[[$this initializer] assoc] ooplType] isA OPBaseType]} { 
  1475.               return
  1476.               }
  1477.               if {[[[[$this initializer] assoc] ooplType] ooplClass] != ""} {
  1478.                  if {[[[[[$this initializer] assoc] ooplType] ooplClass] baseType] == "NodeControl" ||
  1479.                      [[[[[$this initializer] assoc] ooplType] ooplClass] baseType] == "LeafControl"} {
  1480.                     return    
  1481.                  }
  1482.               }
  1483.               $param name "a_[$this getName]"
  1484.            } else {
  1485.               $param name [$this getName]
  1486.            }
  1487.         } else {
  1488.            $param name [$this getName]
  1489.         }
  1490.  
  1491.         if {[$this getPropertyValue "pass_by"] != "ByRef"} {
  1492.             $param passedBy [$this getPropertyValue "pass_by"]
  1493.     }
  1494.  
  1495.         if {[$this getPropertyValue "optional"] != ""} {
  1496.            $param optional [$this getPropertyValue "optional"]
  1497.         }
  1498.   
  1499.         if {[$this getPropertyValue "default_value"] != ""} {
  1500.            $param defaultValue [$this getPropertyValue "default_value"]
  1501.         }
  1502.  
  1503.         $method addArg $param
  1504. }
  1505.  
  1506. # Do not delete this line -- regeneration end marker
  1507.  
  1508. if [isCommand CMCtorParameter] {
  1509.     Class  VBGCtorParameterD : {VBGCtorParameter CMCtorParameter} {
  1510.     }
  1511. } else {
  1512.     Class VBGCtorParameterD : {VBGCtorParameter OPCtorParameter} {    
  1513.     }
  1514. }
  1515.  
  1516. global mostDerivedOOPL ; set mostDerivedOOPL(OPCtorParameter) VBGCtorParameterD
  1517.  
  1518. selfPromoter OPCtorParameter {this} {
  1519.     VBGCtorParameterD promote $this
  1520. }
  1521.  
  1522.  
  1523. #---------------------------------------------------------------------------
  1524. #      File:           @(#)vbgoperpar.tcl    /main/titanic/5
  1525.  
  1526.  
  1527. Class VBGOperParameter : {VBGParameter} {
  1528.     constructor
  1529.     method destructor
  1530.     method generate
  1531. }
  1532.  
  1533. constructor VBGOperParameter {class this name} {
  1534.     set this [VBGParameter::constructor $class $this $name]
  1535.     # Start constructor user section
  1536.     # End constructor user section
  1537.     return $this
  1538. }
  1539.  
  1540. method VBGOperParameter::destructor {this} {
  1541.     # Start destructor user section
  1542.     # End destructor user section
  1543. }
  1544.  
  1545. method VBGOperParameter::generate {this method} {
  1546.     if {[$this checkLocal] != 0} {
  1547.         return
  1548.     }
  1549.  
  1550.         set param [VBArgument new [[$this ooplType] generate]]
  1551.         $param name [$this getName]
  1552.  
  1553.         if {[$this getPropertyValue "pass_by"] != "ByRef"} {
  1554.             $param passedBy [$this getPropertyValue "pass_by"]
  1555.     }
  1556.  
  1557.         if {[$this getPropertyValue "optional"] != ""} {
  1558.                $param optional [$this getPropertyValue "optional"]
  1559.            }
  1560.  
  1561.            if {[$this getPropertyValue "default_value"] != ""} {
  1562.               $param defaultValue [$this getPropertyValue "default_value"]
  1563.            }
  1564.  
  1565.            $method addArg $param
  1566. }
  1567.  
  1568. # Do not delete this line -- regeneration end marker
  1569.  
  1570. if [isCommand CMOperParameter] {
  1571.     Class  VBGOperParameterD : {VBGOperParameter CMOperParameter} {
  1572.     }
  1573. } else {
  1574.     Class VBGOperParameterD : {VBGOperParameter OPOperParameter} {    
  1575.     }
  1576. }
  1577.  
  1578. global mostDerivedOOPL ; set mostDerivedOOPL(OPOperParameter) VBGOperParameterD
  1579.  
  1580. selfPromoter OPOperParameter {this} {
  1581.     VBGOperParameterD promote $this
  1582. }
  1583.  
  1584.  
  1585. #---------------------------------------------------------------------------
  1586. #      File:           @(#)vbgassocin.tcl    /main/titanic/8
  1587.  
  1588.  
  1589. Class VBGAssocInitializer : {VBGInitializer} {
  1590.     constructor
  1591.     method destructor
  1592.     method generate
  1593. }
  1594.  
  1595. constructor VBGAssocInitializer {class this name} {
  1596.     set this [VBGInitializer::constructor $class $this $name]
  1597.     # Start constructor user section
  1598.     # End constructor user section
  1599.     return $this
  1600. }
  1601.  
  1602. method VBGAssocInitializer::destructor {this} {
  1603.     # Start destructor user section
  1604.     # End destructor user section
  1605. }
  1606.  
  1607. method VBGAssocInitializer::generate {this ctor} {
  1608.         if {[[[$this assoc] ooplType] isA OPBaseType]} {
  1609.            return
  1610.         }
  1611.         if {[[[$this assoc] ooplType] ooplClass] != ""} {
  1612.            if {[[[[$this assoc] ooplType] ooplClass] baseType] == "NodeControl" ||
  1613.                [[[[$this assoc] ooplType] ooplClass] baseType] == "LeafControl"} {
  1614.                return
  1615.            }
  1616.         }
  1617.         if {[[$this assoc] getMultiplicity] == "one"} { 
  1618.             if {[[$this assoc] isMandatory] &&
  1619.                 [[$this assoc] opposite] != ""} { 
  1620.                if {[[[$this assoc] opposite] isQualified]} {
  1621. #                 [$ctor gencode] append "a_[$this getName].Add[cap [[[$this assoc] opposite] getName]] Me, CStr([$this getName]_[[[[$this assoc] opposite] qualifier] getName])\n"
  1622.           m4_warning $W_NOCTOR [$this getName]
  1623.                } else {
  1624.                   [$ctor gencode] append "Set [[$this assoc] getName] = a_[$this getName]\n"
  1625.                }
  1626.             } else {
  1627.                [$ctor gencode] append "Set [[$this assoc] getName] = a_[$this getName]\n"
  1628.             }
  1629.         } else {
  1630.            [$ctor gencode] append "Add[cap [[$this assoc] getName]] a_[$this getName]\n"
  1631.         }
  1632. }
  1633.  
  1634. # Do not delete this line -- regeneration end marker
  1635.  
  1636. if [isCommand CMAssocInitializer] {
  1637.     Class  VBGAssocInitializerD : {VBGAssocInitializer CMAssocInitializer} {
  1638.     }
  1639. } else {
  1640.     Class VBGAssocInitializerD : {VBGAssocInitializer OPAssocInitializer} {    
  1641.     }
  1642. }
  1643.  
  1644. global mostDerivedOOPL ; set mostDerivedOOPL(OPAssocInitializer) VBGAssocInitializerD
  1645.  
  1646. selfPromoter OPAssocInitializer {this} {
  1647.     VBGAssocInitializerD promote $this
  1648. }
  1649.  
  1650.  
  1651. #---------------------------------------------------------------------------
  1652. #      File:           @(#)vbgattribi.tcl    /main/titanic/6
  1653.  
  1654.  
  1655. Class VBGAttribInitializer : {VBGInitializer} {
  1656.     constructor
  1657.     method destructor
  1658.     method check
  1659.     method checkLocal
  1660.     method generate
  1661. }
  1662.  
  1663. constructor VBGAttribInitializer {class this name} {
  1664.     set this [VBGInitializer::constructor $class $this $name]
  1665.     # Start constructor user section
  1666.     # End constructor user section
  1667.     return $this
  1668. }
  1669.  
  1670. method VBGAttribInitializer::destructor {this} {
  1671.     # Start destructor user section
  1672.     # End destructor user section
  1673. }
  1674.  
  1675. method VBGAttribInitializer::check {this} {
  1676.         set errornr [$this checkLocal]
  1677.         return $errornr
  1678. }
  1679.  
  1680. method VBGAttribInitializer::checkLocal {this} {
  1681.         set errornr 0
  1682.         if {[[$this attrib] isClassFeature]} {
  1683.            m4_error $W_NOKEYFEAT [[$this attrib] getName] [[[$this attrib] ooplClass] getName]
  1684.        incr errornr 1
  1685.         }
  1686.         return $errornr
  1687. }
  1688.  
  1689. method VBGAttribInitializer::generate {this ctor} {
  1690.     if {[$this checkLocal] > 0} {
  1691.         return
  1692.     }
  1693.  
  1694.         if {[[[$this attrib] ooplType] get_obj_type] == "class_type" ||
  1695.             [[[$this attrib] ooplType] getType3GL] == "Object"} {
  1696.             [$ctor gencode] append "Set "
  1697.         }
  1698.  
  1699.         [$ctor gencode] append [[$this attrib] getName]
  1700.         [$ctor gencode] append " = "
  1701.         [$ctor gencode] append [$this getName]
  1702.         [$ctor gencode] append "\n"
  1703. }
  1704.  
  1705. # Do not delete this line -- regeneration end marker
  1706.  
  1707. if [isCommand CMAttribInitializer] {
  1708.     Class  VBGAttribInitializerD : {VBGAttribInitializer CMAttribInitializer} {
  1709.     }
  1710. } else {
  1711.     Class VBGAttribInitializerD : {VBGAttribInitializer OPAttribInitializer} {    
  1712.     }
  1713. }
  1714.  
  1715. global mostDerivedOOPL ; set mostDerivedOOPL(OPAttribInitializer) VBGAttribInitializerD
  1716.  
  1717. selfPromoter OPAttribInitializer {this} {
  1718.     VBGAttribInitializerD promote $this
  1719. }
  1720.  
  1721.  
  1722. #---------------------------------------------------------------------------
  1723. #      File:           @(#)vbgqualini.tcl    /main/titanic/6
  1724.  
  1725.  
  1726. Class VBGQualInitializer : {VBGInitializer} {
  1727.     constructor
  1728.     method destructor
  1729.     method generate
  1730. }
  1731.  
  1732. constructor VBGQualInitializer {class this name} {
  1733.     set this [VBGInitializer::constructor $class $this $name]
  1734.     # Start constructor user section
  1735.     # End constructor user section
  1736.     return $this
  1737. }
  1738.  
  1739. method VBGQualInitializer::destructor {this} {
  1740.     # Start destructor user section
  1741.     # End destructor user section
  1742. }
  1743.  
  1744. method VBGQualInitializer::generate {this ctor} {
  1745. }
  1746.  
  1747. # Do not delete this line -- regeneration end marker
  1748.  
  1749. if [isCommand CMQualInitializer] {
  1750.     Class  VBGQualInitializerD : {VBGQualInitializer CMQualInitializer} {
  1751.     }
  1752. } else {
  1753.     Class VBGQualInitializerD : {VBGQualInitializer OPQualInitializer} {    
  1754.     }
  1755. }
  1756.  
  1757. global mostDerivedOOPL ; set mostDerivedOOPL(OPQualInitializer) VBGQualInitializerD
  1758.  
  1759. selfPromoter OPQualInitializer {this} {
  1760.     VBGQualInitializerD promote $this
  1761. }
  1762.  
  1763.  
  1764. #---------------------------------------------------------------------------
  1765. #      File:           @(#)vbgsupercl.tcl    /main/titanic/6
  1766.  
  1767.  
  1768. Class VBGSuperClassInitializer : {VBGInitializer} {
  1769.     constructor
  1770.     method destructor
  1771.     method generate
  1772. }
  1773.  
  1774. constructor VBGSuperClassInitializer {class this name} {
  1775.     set this [VBGInitializer::constructor $class $this $name]
  1776.     # Start constructor user section
  1777.     # End constructor user section
  1778.     return $this
  1779. }
  1780.  
  1781. method VBGSuperClassInitializer::destructor {this} {
  1782.     # Start destructor user section
  1783.     # End destructor user section
  1784. }
  1785.  
  1786. method VBGSuperClassInitializer::generate {this ctor} {
  1787.         if {[[[$this constructor] ooplClass] baseClass] == "Class"} {
  1788.                [$ctor gencode] append "[[$this ooplClass] getName].[[$this ooplClass] getName]_Constructor"
  1789.            set first 1
  1790.                foreach param [$this parameterSet] {
  1791.               if {!$first} {
  1792.                               [$ctor gencode] append ", "
  1793.               } else {
  1794.                               [$ctor gencode] append " "
  1795.                        set first 0
  1796.               }
  1797.                       [$ctor gencode] append "[$param getName]"
  1798.                }
  1799.                [$ctor gencode] append "\n"                
  1800.         }
  1801. }
  1802.  
  1803. # Do not delete this line -- regeneration end marker
  1804.  
  1805. if [isCommand CMSuperClassInitializer] {
  1806.     Class  VBGSuperClassInitializerD : {VBGSuperClassInitializer CMSuperClassInitializer} {
  1807.     }
  1808. } else {
  1809.     Class VBGSuperClassInitializerD : {VBGSuperClassInitializer OPSuperClassInitializer} {    
  1810.     }
  1811. }
  1812.  
  1813. global mostDerivedOOPL ; set mostDerivedOOPL(OPSuperClassInitializer) VBGSuperClassInitializerD
  1814.  
  1815. selfPromoter OPSuperClassInitializer {this} {
  1816.     VBGSuperClassInitializerD promote $this
  1817. }
  1818.  
  1819.  
  1820. #---------------------------------------------------------------------------
  1821. #      File:           @(#)vbgbasetyp.tcl    /main/titanic/3
  1822.  
  1823.  
  1824. Class VBGBaseType : {VBGType} {
  1825.     constructor
  1826.     method destructor
  1827.     method generate
  1828. }
  1829.  
  1830. constructor VBGBaseType {class this name} {
  1831.     set this [VBGType::constructor $class $this $name]
  1832.     # Start constructor user section
  1833.     # End constructor user section
  1834.     return $this
  1835. }
  1836.  
  1837. method VBGBaseType::destructor {this} {
  1838.     # Start destructor user section
  1839.     # End destructor user section
  1840. }
  1841.  
  1842. method VBGBaseType::generate {this} {
  1843.         set type [VBType new]
  1844.         $type name [$this getType3GL]
  1845.         return $type
  1846. }
  1847.  
  1848. # Do not delete this line -- regeneration end marker
  1849.  
  1850. if [isCommand CMBaseType] {
  1851.     Class  VBGBaseTypeD : {VBGBaseType CMBaseType} {
  1852.     }
  1853. } else {
  1854.     Class VBGBaseTypeD : {VBGBaseType OPBaseType} {    
  1855.     }
  1856. }
  1857.  
  1858. global mostDerivedOOPL ; set mostDerivedOOPL(OPBaseType) VBGBaseTypeD
  1859.  
  1860. selfPromoter OPBaseType {this} {
  1861.     VBGBaseTypeD promote $this
  1862. }
  1863.  
  1864.  
  1865. #---------------------------------------------------------------------------
  1866. #      File:           @(#)vbgclassty.tcl    /main/titanic/4
  1867.  
  1868.  
  1869. Class VBGClassType : {VBGType} {
  1870.     constructor
  1871.     method destructor
  1872.     method generate
  1873. }
  1874.  
  1875. constructor VBGClassType {class this name} {
  1876.     set this [VBGType::constructor $class $this $name]
  1877.     # Start constructor user section
  1878.     # End constructor user section
  1879.     return $this
  1880. }
  1881.  
  1882. method VBGClassType::destructor {this} {
  1883.     # Start destructor user section
  1884.     # End destructor user section
  1885. }
  1886.  
  1887. method VBGClassType::generate {this} {
  1888.         set type [VBType new]
  1889.         if {[$this ooplClass] != ""} {
  1890.            set name [[$this ooplClass] getName]
  1891.         } else {
  1892.            set name ""
  1893.         }
  1894.         $type name $name                      
  1895.         return $type
  1896. }
  1897.  
  1898. # Do not delete this line -- regeneration end marker
  1899.  
  1900. if [isCommand CMClassType] {
  1901.     Class  VBGClassTypeD : {VBGClassType CMClassType} {
  1902.     }
  1903. } else {
  1904.     Class VBGClassTypeD : {VBGClassType OPClassType} {    
  1905.     }
  1906. }
  1907.  
  1908. global mostDerivedOOPL ; set mostDerivedOOPL(OPClassType) VBGClassTypeD
  1909.  
  1910. selfPromoter OPClassType {this} {
  1911.     VBGClassTypeD promote $this
  1912. }
  1913.  
  1914.  
  1915. #---------------------------------------------------------------------------
  1916. #      File:           @(#)vbgenumtyp.tcl    /main/titanic/5
  1917.  
  1918.  
  1919. Class VBGEnumType : {VBGType} {
  1920.     constructor
  1921.     method destructor
  1922.     method generate
  1923. }
  1924.  
  1925. constructor VBGEnumType {class this name} {
  1926.     set this [VBGType::constructor $class $this $name]
  1927.     # Start constructor user section
  1928.     # End constructor user section
  1929.     return $this
  1930. }
  1931.  
  1932. method VBGEnumType::destructor {this} {
  1933.     # Start destructor user section
  1934.     # End destructor user section
  1935. }
  1936.  
  1937. method VBGEnumType::generate {this} {
  1938.         set type [VBType new]
  1939.         if {[$this ooplClass] != ""} {
  1940.            set name [[$this ooplClass] getName]
  1941.         } else {
  1942.            set name ""
  1943.         }
  1944.         $type name $name
  1945.         return $type
  1946. }
  1947.  
  1948. # Do not delete this line -- regeneration end marker
  1949.  
  1950. if [isCommand CMEnumType] {
  1951.     Class  VBGEnumTypeD : {VBGEnumType CMEnumType} {
  1952.     }
  1953. } else {
  1954.     Class VBGEnumTypeD : {VBGEnumType OPEnumType} {    
  1955.     }
  1956. }
  1957.  
  1958. global mostDerivedOOPL ; set mostDerivedOOPL(OPEnumType) VBGEnumTypeD
  1959.  
  1960. selfPromoter OPEnumType {this} {
  1961.     VBGEnumTypeD promote $this
  1962. }
  1963.  
  1964.  
  1965. #---------------------------------------------------------------------------
  1966. #      File:           @(#)vbgassocma.tcl    /main/titanic/8
  1967.  
  1968.  
  1969. Class VBGAssocMany : {VBGAssocGen} {
  1970.     constructor
  1971.     method destructor
  1972.     method hasAdd
  1973.     method hasDtor
  1974.     method hasRemove
  1975.     method generate
  1976.     method generateGet
  1977.     method generateAdd
  1978.     method generateRemove
  1979.     method generateDtor
  1980. }
  1981.  
  1982. constructor VBGAssocMany {class this assocattr} {
  1983.     set this [VBGAssocGen::constructor $class $this $assocattr]
  1984.     # Start constructor user section
  1985.     # End constructor user section
  1986.     return $this
  1987. }
  1988.  
  1989. method VBGAssocMany::destructor {this} {
  1990.     # Start destructor user section
  1991.     # End destructor user section
  1992.     $this VBGAssocGen::destructor
  1993. }
  1994.  
  1995. method VBGAssocMany::hasAdd {this self} {
  1996.         set wr [$this hasWrite]
  1997.         if {$self} {
  1998.                 if {$wr == "None"} {
  1999.                         return 0
  2000.                 }
  2001.         } else {
  2002.                 if {$wr == "None" || $wr == "Private"} {
  2003.                         return 0
  2004.                 }
  2005.         }
  2006.         if {[[$this assocattr] opposite] != ""} {
  2007.            if {[[[$this assocattr] opposite] isQualified]} {
  2008.           if {$self} {m4_warning $W_NOSET [[$this assocattr] getName]}
  2009.               return 0
  2010.            }
  2011.         }
  2012.         return 1
  2013. }
  2014.  
  2015. method VBGAssocMany::hasDtor {this self} {
  2016.         if {[[$this assocattr] opposite] != ""} {
  2017.            if {[[[$this assocattr] opposite] isMandatory] && [[[$this assocattr] opposite] getMultiplicity] == "one"} {
  2018.               return 0
  2019.            }
  2020.            if {[[[$this assocattr] opposite] isQualified]} {
  2021.               if {$self} {m4_warning $W_NODTOR [[$this assocattr] getName]}
  2022.               return 0
  2023.            }
  2024.     }
  2025.     return 1
  2026. }
  2027.  
  2028. method VBGAssocMany::hasRemove {this self} {
  2029.         set wr [$this hasWrite]
  2030.         if {$self} {
  2031.                 if {$wr == "None"} {
  2032.                         return 0
  2033.                 }
  2034.         } else {
  2035.                 if {$wr == "None" || $wr == "Private"} {
  2036.                         return 0
  2037.                 }
  2038.         }
  2039.         if {[[$this assocattr] opposite] != ""} {
  2040.            if {[[[$this assocattr] opposite] isMandatory] && [[[$this assocattr] opposite] getMultiplicity] == "one"} {
  2041.               return 0
  2042.            }
  2043.            if {[[[$this assocattr] opposite] isQualified]} {
  2044.               if {$self} {m4_warning $W_NOREMOVE [[$this assocattr] getName]}
  2045.               return 0
  2046.            }
  2047.         }
  2048.     return 1
  2049. }
  2050.  
  2051. method VBGAssocMany::generate {this cl} {
  2052.         set type [VBType new]
  2053.         $type name "New ClassSet"
  2054.         set vari [VBVariable new $type]
  2055.         $vari name "[[$this assocattr] getName]_"
  2056.         $cl addAssocvar $vari
  2057.         $vari access "Private"
  2058.         if {[[$this assocattr] opposite] != ""} {
  2059.                 [[$this assocattr] opposite] setGenerator
  2060.         }
  2061.         $this generateGet $vari
  2062.         $this generateAdd $vari
  2063.         $this generateRemove $vari
  2064.         $this generateDtor $cl
  2065. }
  2066.  
  2067. method VBGAssocMany::generateGet {this vari} {
  2068.         if {![$this hasGet 0]} {
  2069.                 $vari access "Public"
  2070.         }
  2071.         if {![$this hasGet 1]} {
  2072.                 return
  2073.         }
  2074.         set type [VBType new]
  2075.         $type name "ClassSet"
  2076.         set getproc [VBGetProperty new $type]
  2077.         set getcode [TextSection new]
  2078.         $getproc gencode $getcode
  2079.         $getproc hasUserSection 0
  2080.         $getproc access [$this hasRead]
  2081.         $getproc name [[$this assocattr] getName]
  2082.         $getcode append "Set "
  2083.         $getcode append "[[$this assocattr] getName] = "
  2084.         $getcode append "[[$this assocattr] getName]_\n"
  2085.         $vari addProc $getproc
  2086. }
  2087.  
  2088. method VBGAssocMany::generateAdd {this vari} {
  2089.         if {![$this hasAdd 0]} {
  2090.                 $vari access "Public"
  2091.         }
  2092.         if {![$this hasAdd 1]} {
  2093.                 return
  2094.         }
  2095.         set type [VBType new]
  2096.         $type name [[[[$this assocattr] ooplType] ooplClass] getName]
  2097.         set arg [VBArgument new $type]
  2098.         $arg name "x"
  2099.         set addsub [VBSub new]
  2100.         $addsub addArg $arg
  2101.         set addcode [TextSection new]
  2102.  
  2103.         $addsub gencode $addcode
  2104.         $addsub hasUserSection 0
  2105.         $addsub access [$this hasWrite]
  2106.         $addsub name "Add[cap [[$this assocattr] getName]]"
  2107.  
  2108.         $addcode append "If Not([$vari name].Contains(x)) Then\n"
  2109.         $addcode indent +
  2110.         $addcode append "[$vari name].Add x\n"
  2111.         
  2112.         if {[[$this assocattr] opposite] != ""} {
  2113.             if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {
  2114.         if {[[[[$this assocattr] opposite] generator] hasAdd 0]} {
  2115.                     $addcode append "x.Add[cap [[[$this assocattr] opposite] getName]] Me\n"
  2116.            } else {
  2117.                     $addcode append "x.[[[$this assocattr] opposite] getName]_.Add Me\n"
  2118.         }
  2119.             } else {
  2120.         if {[[[[$this assocattr] opposite] generator] hasSet 0]} {
  2121.                     $addcode append "Set x.[[[$this assocattr] opposite] getName] = Me\n"
  2122.         } else {
  2123.                   $addcode append "If Not(x.[[[$this assocattr] opposite] getName]_ Is Nothing) Then\n"
  2124.                         $addcode indent +
  2125.             if {[$this hasRemove 1]} {
  2126.                 $addcode append "x.[[[$this assocattr] opposite] getName]_.Remove[cap [[$this assocattr] getName]] x\n"
  2127.             } else {
  2128.                 $addcode append "x.[[[$this assocattr] opposite] getName]_.[[$this assocattr] getName]_.Remove x\n"
  2129.                 if {[[[[$this assocattr] opposite] generator] hasRemove 0]} {
  2130.                     $addcode append "x.Remove[cap [[[$this assocattr] opposite] getName]]\n"
  2131.                 } else {
  2132.                     $addcode append "Set x.[[[$this assocattr] opposite] getName]_ = Nothing\n"
  2133.                 }
  2134.             }
  2135.                         $addcode indent -
  2136.                         $addcode append "End If\n"
  2137.                     $addcode append "Set x.[[[$this assocattr] opposite] getName]_ = Me\n"
  2138.         }
  2139.             }
  2140.         }
  2141.         $addcode indent -
  2142.         $addcode append "End If\n"
  2143.  
  2144.         $vari addProc $addsub
  2145. }
  2146.  
  2147. method VBGAssocMany::generateRemove {this vari} {
  2148.         if {![$this hasRemove 0]} {
  2149.                 $vari access "Public"
  2150.         }
  2151.         if {![$this hasRemove 1]} {
  2152.                 return
  2153.         }
  2154.         set removesub [VBSub new]
  2155.         set type [VBType new]
  2156.         $type name [[[[$this assocattr] ooplType] ooplClass] getName]
  2157.         set arg [VBArgument new $type]
  2158.         $arg name "x"
  2159.         $removesub addArg $arg
  2160.         set removecode [TextSection new]
  2161.         $removesub gencode $removecode
  2162.         $removesub hasUserSection 0
  2163.         $removesub access [$this hasWrite]
  2164.         $removesub name "Remove[cap [[$this assocattr] getName]]"
  2165.  
  2166.         if {[[$this assocattr] opposite] != ""} {
  2167.             $removecode append "If [$vari name].Contains(x) Then\n"
  2168.             $removecode indent +
  2169.             $removecode append "[$vari name].Remove x\n"
  2170.  
  2171.             if {[[[[$this assocattr] opposite] generator] hasRemove 0]} {
  2172.                 $removecode append "x.Remove[cap [[[$this assocattr] opposite] getName]]"
  2173.                 if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {
  2174.                         $removecode append " Me"
  2175.                 }
  2176.             } else {
  2177.                if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {
  2178.                    $removecode append "x.[[[$this assocattr] opposite] getName]_.Remove Me"
  2179.                } else {
  2180.                    $removecode append "Set x.[[[$this assocattr] opposite] getName]_ = Nothing"
  2181.                }
  2182.             }
  2183.  
  2184.             $removecode append "\n"
  2185.             $removecode indent -
  2186.             $removecode append "End If\n"
  2187.         } else {
  2188.             $removecode append "[$vari name].Remove x\n"
  2189.         }
  2190.         $vari addProc $removesub
  2191. }
  2192.  
  2193. method VBGAssocMany::generateDtor {this cl} {
  2194.         if {![$this hasDtor 1]} {
  2195.                 return
  2196.         }
  2197.         if {[[$this assocattr] opposite] != ""} {
  2198.            [[$cl terminate] gencode] append "While [[$this assocattr] getName]_.Count > 0\n"
  2199.            [[$cl terminate] gencode] indent +
  2200.  
  2201.         if {[$this hasRemove 1]} {
  2202.               [[$cl terminate] gencode] append "Remove[cap [[$this assocattr] getName]] [[$this assocattr] getName]_.item(1)\n"
  2203.        } else {
  2204.               [[$cl terminate] gencode] append "Dim temp As [[[[$this assocattr] ooplType] ooplClass] getName]\n"
  2205.               [[$cl terminate] gencode] append "Set temp = [[$this assocattr] getName]_.item(1)\n"
  2206.               [[$cl terminate] gencode] append "[[$this assocattr] getName]_.Remove temp\n"
  2207.               if {[[[[$this assocattr] opposite] generator] hasRemove 0]} {
  2208.                     [[$cl terminate] gencode] append "temp.Remove[cap [[[$this assocattr] opposite] getName]]"
  2209.                   if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {
  2210.                             [[$cl terminate] gencode] append " Me"
  2211.                   }
  2212.               } else {
  2213.                  if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {
  2214.                      [[$cl terminate] gencode] append "temp.[[[$this assocattr] opposite] getName]_.Remove Me"
  2215.                  } else {
  2216.                      [[$cl terminate] gencode] append "Set temp.[[[$this assocattr] opposite] getName]_ = Nothing"
  2217.                  }
  2218.               }
  2219.             [[$cl terminate] gencode] append "\n"
  2220.        }
  2221.            [[$cl terminate] gencode] indent -
  2222.            [[$cl terminate] gencode] append "Wend\n"
  2223.         }
  2224. }
  2225.  
  2226. # Do not delete this line -- regeneration end marker
  2227.  
  2228.  
  2229.  
  2230. #---------------------------------------------------------------------------
  2231. #      File:           @(#)vbgassocon.tcl    /main/titanic/9
  2232.  
  2233.  
  2234. Class VBGAssocOne : {VBGAssocGen} {
  2235.     constructor
  2236.     method destructor
  2237.     method hasSet
  2238.     method hasDtor
  2239.     method hasRemove
  2240.     method generate
  2241.     method generateSet
  2242.     method generateGet
  2243.     method generateRemove
  2244.     method generateDtor
  2245. }
  2246.  
  2247. constructor VBGAssocOne {class this assocattr} {
  2248.     set this [VBGAssocGen::constructor $class $this $assocattr]
  2249.     # Start constructor user section
  2250.     # End constructor user section
  2251.     return $this
  2252. }
  2253.  
  2254. method VBGAssocOne::destructor {this} {
  2255.     # Start destructor user section
  2256.     # End destructor user section
  2257.     $this VBGAssocGen::destructor
  2258. }
  2259.  
  2260. method VBGAssocOne::hasSet {this self} {
  2261.         set wr [$this hasWrite]
  2262.         if {$self} {
  2263.                 if {$wr == "None"} {
  2264.                         return 0
  2265.                 }
  2266.         } else {
  2267.                 if {$wr == "None" || $wr == "Private"} {
  2268.                         return 0
  2269.                 }
  2270.         }
  2271.         if {[[$this assocattr] opposite] != ""} {
  2272.        if {[[[$this assocattr] opposite] isMandatory] && [[[$this assocattr] opposite] getMultiplicity] == "one"} {
  2273.               return 0
  2274.        }
  2275.            if {[[[$this assocattr] opposite] isQualified]} {
  2276.               if {$self} {m4_warning $W_NOADD [[$this assocattr] getName]}
  2277.               return 0
  2278.            }
  2279.         }
  2280.         return 1
  2281. }
  2282.  
  2283. method VBGAssocOne::hasDtor {this self} {
  2284.         if {[[$this assocattr] opposite] != ""} {
  2285.            if {[[[$this assocattr] opposite] isMandatory] && [[[$this assocattr] opposite] getMultiplicity] == "one"} {
  2286.               return 0
  2287.            }
  2288.            if {[[[$this assocattr] opposite] isQualified]} {
  2289.               if {$self} {m4_warning $W_NODTOR [[$this assocattr] getName]}
  2290.               return 0
  2291.            }
  2292.     }
  2293.     return 1
  2294. }
  2295.  
  2296. method VBGAssocOne::hasRemove {this self} {
  2297.         set wr [$this hasWrite]
  2298.         if {$self} {
  2299.                 if {$wr == "None"} {
  2300.                         return 0
  2301.                 }
  2302.         } else {
  2303.                 if {$wr == "None" || $wr == "Private"} {
  2304.                         return 0
  2305.                 }
  2306.         }
  2307.         if {[[$this assocattr] opposite] != ""} {
  2308.            if {[[[$this assocattr] opposite] isMandatory] && [[[$this assocattr] opposite] getMultiplicity] == "one"} {
  2309.               return 0
  2310.            }
  2311.            if {[[[$this assocattr] opposite] isQualified]} {
  2312.               if {$self} {m4_warning $W_NOREMOVE [[$this assocattr] getName]}
  2313.               return 0
  2314.            }
  2315.         }
  2316.         if {[[$this assocattr] isMandatory]} {
  2317.            return 0
  2318.         }
  2319.         return 1
  2320. }
  2321.  
  2322. method VBGAssocOne::generate {this cl} {
  2323.         set type [VBType new]
  2324.         $type name [[[[$this assocattr] ooplType] ooplClass] getName]
  2325.         set vari [VBVariable new $type]
  2326.         $vari name "[[$this assocattr] getName]_"
  2327.         $cl addAssocvar $vari
  2328.         $vari access "Private"
  2329.     if {[[$this assocattr] opposite] != ""} {
  2330.         [[$this assocattr] opposite] setGenerator
  2331.     }
  2332.         $this generateGet $vari
  2333.         $this generateSet $vari
  2334.         $this generateRemove $vari
  2335.         $this generateDtor $cl
  2336. }
  2337.  
  2338. method VBGAssocOne::generateSet {this vari} {
  2339.     if {![$this hasSet 0]} {
  2340.         $vari access "Public"
  2341.     }
  2342.     if {![$this hasSet 1]} {
  2343.         return
  2344.     }
  2345.         set type [VBType new]
  2346.         $type name [[[[$this assocattr] ooplType] ooplClass] getName]
  2347.         set arg [VBArgument new $type]
  2348.         $arg name "x"
  2349.         set setproc [VBSetProperty new]
  2350.         $setproc addArg $arg
  2351.         set setcode [TextSection new]
  2352.         
  2353.         $setproc gencode $setcode
  2354.         $setproc hasUserSection 0
  2355.         $setproc access [$this hasWrite]
  2356.         $setproc name [[$this assocattr] getName]
  2357.         if {[[$this assocattr] opposite] != ""} {
  2358.             $setcode append "If Not (x Is Nothing) Then\n"
  2359.             $setcode indent +
  2360.  
  2361.             if {[[$this assocattr] isMandatory]} {
  2362.                  if {[[[$this assocattr] opposite] getMultiplicity] == "one"} {
  2363.                     if {[[[[$this assocattr] opposite] generator] hasGet 0]} {
  2364.                        $setcode append "If x.[[[$this assocattr] opposite] getName] Is Nothing Then\n"
  2365.             } else {
  2366.                        $setcode append "If x.[[[$this assocattr] opposite] getName]_ Is Nothing Then\n"
  2367.             }
  2368.                     $setcode indent +
  2369.                     $setcode append "If Not ([$vari name] Is Nothing) Then\n"
  2370.                     $setcode indent +
  2371.                     $setcode append "Set [$vari name].[[[$this assocattr] opposite] getName]_ = Nothing\n"
  2372.                     $setcode indent -
  2373.                     $setcode append "End If\n"
  2374.                  } else {
  2375.                     $setcode append "If Not (x Is [$vari name]) Then\n"
  2376.                     $setcode indent +
  2377.                     $setcode append "If Not ([$vari name] Is Nothing) Then\n"
  2378.                     $setcode indent +
  2379.                     $setcode append "[$vari name].[[[$this assocattr] opposite] getName]_.Remove Me\n"
  2380.                     $setcode indent -
  2381.                     $setcode append "End If\n"
  2382.                  }
  2383.             } else {
  2384.                  $setcode append "If Not (x Is [$vari name]) Then\n"
  2385.                  $setcode indent +
  2386.                  $setcode append "If Not ([$vari name] Is Nothing) Then\n"
  2387.                  $setcode indent +
  2388.                  if {[[[[$this assocattr] opposite] generator] hasRemove 0]} {
  2389.                      $setcode append "[$vari name].Remove[cap [[[$this assocattr] opposite] getName]]"
  2390.                      if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {
  2391.                          $setcode append " Me"
  2392.                      }
  2393.          } else {
  2394.                      if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {
  2395.                          $setcode append "[$vari name].[[[$this assocattr] opposite] getName]_.Remove Me"
  2396.                      } else {
  2397.                          $setcode append "Set [$vari name].[[[$this assocattr] opposite] getName]_ = Nothing"
  2398.              }
  2399.          }
  2400.                  $setcode append "\n"
  2401.                  $setcode indent -
  2402.                  $setcode append "End If\n"
  2403.             }
  2404.  
  2405.             $setcode append "Set [$vari name] = x\n"
  2406.  
  2407.             if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {
  2408.                 if {[[[[$this assocattr] opposite] generator] hasAdd 0]} {
  2409.                    $setcode append "x.Add[cap [[[$this assocattr] opposite] getName]] Me\n"
  2410.                 } else {
  2411.                    $setcode append "x.[[[$this assocattr] opposite] getName]_.Add Me\n"
  2412.                 }
  2413.             } else {
  2414.                 if {[[[[$this assocattr] opposite] generator] hasSet 0]} {
  2415.                     $setcode append "Set x.[[[$this assocattr] opposite] getName] = Me\n"
  2416.                 } else {
  2417.                     $setcode append "Set x.[[[$this assocattr] opposite] getName]_ = Me\n"
  2418.                 }
  2419.             }
  2420.             $setcode indent -
  2421.             $setcode append "End If\n"
  2422.  
  2423.             if {[$this hasRemove 1]} {
  2424.                $setcode indent -
  2425.                $setcode append "Else\n"
  2426.                $setcode indent +
  2427.                $setcode append "Remove[cap [[$this assocattr] getName]]\n"
  2428.             }
  2429.             $setcode indent -
  2430.             $setcode append "End If\n"
  2431.         } else {
  2432.             if {[[$this assocattr] isMandatory]} {
  2433.                  $setcode append "If Not (x Is Nothing) Then\n"
  2434.                  $setcode indent +
  2435.                  $setcode append "Set [$vari name] = x\n"
  2436.                  $setcode indent -
  2437.                  $setcode append "End If\n"
  2438.             } else {
  2439.                  $setcode append "Set [$vari name] = x\n"
  2440.             }
  2441.         }
  2442.         $vari addProc $setproc
  2443. }
  2444.  
  2445. method VBGAssocOne::generateGet {this vari} {
  2446.     if {![$this hasGet 0]} {
  2447.         $vari access "Public"
  2448.     }
  2449.     if {![$this hasGet 1]} {
  2450.         return
  2451.     }
  2452.         set type [VBType new]
  2453.         $type name [[[[$this assocattr] ooplType] ooplClass] getName]
  2454.         set getproc [VBGetProperty new $type]
  2455.         set getcode [TextSection new]
  2456.         $getproc gencode $getcode
  2457.         $getproc hasUserSection 0
  2458.         $getproc access [$this hasRead]
  2459.         $getproc name [[$this assocattr] getName]
  2460.         $getcode append "Set "
  2461.         $getcode append "[[$this assocattr] getName] = "
  2462.         $getcode append "[[$this assocattr] getName]_\n"
  2463.         $vari addProc $getproc
  2464. }
  2465.  
  2466. method VBGAssocOne::generateRemove {this vari} {
  2467.     if {![$this hasRemove 0]} {
  2468.         $vari access "Public"
  2469.     }
  2470.     if {![$this hasRemove 1]} {
  2471.         return
  2472.     }
  2473.         set removesub [VBSub new]
  2474.         set removecode [TextSection new]
  2475.         $removesub gencode $removecode
  2476.         $removesub hasUserSection 0
  2477.         $removesub access [$this hasWrite]
  2478.         $removesub name "Remove[cap [[$this assocattr] getName]]"
  2479.         if {[[$this assocattr] opposite] != ""} {
  2480.             $removecode append "If Not ([$vari name] Is Nothing) Then\n"
  2481.             $removecode indent +
  2482.             $removecode append "Dim temp As [[$vari type] name]\n"
  2483.             $removecode append "Set temp = [$vari name]\n"
  2484.             $removecode append "Set [$vari name] = Nothing\n"
  2485.             if {[[[[$this assocattr] opposite] generator] hasRemove 0]} {
  2486.                $removecode append "temp.Remove[cap [[[$this assocattr] opposite] getName]]"
  2487.                if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {
  2488.                    $removecode append " Me"
  2489.                }
  2490.         } else {
  2491.                if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {
  2492.                    $removecode append "temp.[[[$this assocattr] opposite] getName]_.Remove Me"
  2493.                } else {
  2494.                    $removecode append "Set temp.[[[$this assocattr] opposite] getName]_ = Nothing"
  2495.            }
  2496.         }
  2497.             $removecode append "\n"
  2498.             $removecode indent -
  2499.             $removecode append "End If\n"
  2500.         } else {
  2501.             $removecode append "Set [$vari name] = Nothing\n"
  2502.         }
  2503.         $vari addProc $removesub
  2504. }
  2505.  
  2506. method VBGAssocOne::generateDtor {this cl} {
  2507.     if {![$this hasDtor 1]} {
  2508.         return
  2509.     }
  2510.         if {[[$this assocattr] opposite] != ""} {
  2511.            if {[$this hasRemove 1]} {
  2512.                  [[$cl terminate] gencode] append "Remove[cap [[$this assocattr] getName]]\n"
  2513.            } else {
  2514.             [[$cl terminate] gencode] append "If Not ([[$this assocattr] getName]_ Is Nothing) Then\n"
  2515.             [[$cl terminate] gencode] indent +
  2516.             if {[[[[$this assocattr] opposite] generator] hasRemove 0]} {
  2517.                [[$cl terminate] gencode] append "[[$this assocattr] getName]_.Remove[cap [[[$this assocattr] opposite] getName]]"
  2518.                if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {
  2519.                    [[$cl terminate] gencode] append " Me"
  2520.                }
  2521.         } else {
  2522.                if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {
  2523.                    [[$cl terminate] gencode] append "[[$this assocattr] getName]_.[[[$this assocattr] opposite] getName]_.Remove Me"
  2524.                } else {
  2525.                    [[$cl terminate] gencode] append "Set [[$this assocattr] getName]_.[[[$this assocattr] opposite] getName]_ = Nothing"
  2526.            }
  2527.         }
  2528.             [[$cl terminate] gencode] append "\n"
  2529.             [[$cl terminate] gencode] indent -
  2530.             [[$cl terminate] gencode] append "End If\n"
  2531.          }
  2532.     }
  2533. }
  2534.  
  2535. # Do not delete this line -- regeneration end marker
  2536.  
  2537.  
  2538.  
  2539. #---------------------------------------------------------------------------
  2540. #      File:           @(#)vbgqual.tcl    /main/titanic/1
  2541.  
  2542.  
  2543. Class VBGQual : {VBGAssocGen} {
  2544.     constructor
  2545.     method destructor
  2546.     method hasAdd
  2547.     method hasDtor
  2548.     method hasRemove
  2549. }
  2550.  
  2551. constructor VBGQual {class this assocattr} {
  2552.     set this [VBGAssocGen::constructor $class $this $assocattr]
  2553.     # Start constructor user section
  2554.     # End constructor user section
  2555.     return $this
  2556. }
  2557.  
  2558. method VBGQual::destructor {this} {
  2559.     # Start destructor user section
  2560.     # End destructor user section
  2561.     $this VBGAssocGen::destructor
  2562. }
  2563.  
  2564. method VBGQual::hasAdd {this self} {
  2565.         set wr [$this hasWrite]
  2566.         if {$self} {
  2567.                 if {$wr == "None"} {
  2568.                         return 0
  2569.                 }
  2570.         } else {
  2571.                 if {$wr == "None" || $wr == "Private"} {
  2572.                         return 0
  2573.                 }
  2574.         }
  2575.         return 1
  2576. }
  2577.  
  2578. method VBGQual::hasDtor {this self} {
  2579.         if {[[$this assocattr] opposite] != ""} {
  2580.            if {[[[$this assocattr] opposite] isMandatory] && [[[$this assocattr] opposite] getMultiplicity] == "one"} {
  2581.               return 0
  2582.            }
  2583.     }
  2584.     return 1
  2585. }
  2586.  
  2587. method VBGQual::hasRemove {this self} {
  2588.         set wr [$this hasWrite]
  2589.         if {$self} {
  2590.         } else {
  2591.                 if {$wr == "None" || $wr == "Private"} {
  2592.                         return 0
  2593.                 }
  2594.         }
  2595.         if {[[$this assocattr] opposite] != ""} {
  2596.            if {[[[$this assocattr] opposite] isMandatory] && [[[$this assocattr] opposite] getMultiplicity] == "one"} {
  2597.               return 0
  2598.            }
  2599.         }
  2600.     return 1
  2601. }
  2602.  
  2603. # Do not delete this line -- regeneration end marker
  2604.  
  2605.  
  2606.  
  2607. #---------------------------------------------------------------------------
  2608. #      File:           @(#)vbgdataatt.tcl    /main/titanic/11
  2609.  
  2610.  
  2611. Class VBGDataAttr : {VBGAttribute} {
  2612.     constructor
  2613.     method destructor
  2614.     method check
  2615.     method checkLocal
  2616.     method checkLocalSub
  2617.     method checkLocalSubSub
  2618.     method generateSetDefault
  2619.     method generateAccesProcs
  2620.     method generate
  2621. }
  2622.  
  2623. constructor VBGDataAttr {class this name} {
  2624.     set this [VBGAttribute::constructor $class $this $name]
  2625.     # Start constructor user section
  2626.     # End constructor user section
  2627.     return $this
  2628. }
  2629.  
  2630. method VBGDataAttr::destructor {this} {
  2631.     # Start destructor user section
  2632.     # End destructor user section
  2633. }
  2634.  
  2635. method VBGDataAttr::check {this} {
  2636.         set errornr [$this checkLocal]
  2637.         incr errornr [[$this ooplType] check]             
  2638.         return $errornr
  2639. }
  2640.  
  2641. method VBGDataAttr::checkLocal {this} {
  2642.     set errornr [$this checkLocalSub]
  2643.     if {[[$this ooplClass] baseType] == "NodeControl" || [[$this ooplClass] baseType] == "LeafControl"} {
  2644.                 m4_error $E_CONTHASNOAT [[$this ooplClass] getName]
  2645.         incr errornr 1
  2646.     }
  2647.         incr errornr [$this checkLocalSubSub]
  2648.         return $errornr
  2649. }
  2650.  
  2651. method VBGDataAttr::checkLocalSub {this} {
  2652.        set errornr 0
  2653.  
  2654.        if {[[$this ooplType] getType3GL] == "enum" && ![[$this ooplClass] isEnumClass]} {
  2655.            m4_error $E_NOENUM [[$this ooplClass] getName]
  2656.            incr errornr 1
  2657.        }
  2658.        return $errornr
  2659. }
  2660.  
  2661. method VBGDataAttr::checkLocalSubSub {this} {
  2662.        set errornr 0
  2663.        if {[$this getInitialValue] != "" && [$this isClassFeature] && ![[$this ooplClass] isEnumClass]} {
  2664.            m4_error $W_NODEFAULT [$this getName] [[$this ooplClass] getName]
  2665.            incr errornr 1
  2666.        }
  2667.        return $errornr
  2668. }
  2669.  
  2670. method VBGDataAttr::generateSetDefault {this proc} {
  2671.        if {[$this checkLocalSubSub] > 0} {
  2672.           return
  2673.        }
  2674.        if {[$this getInitialValue] != ""} {
  2675.               if {[[$this ooplType] get_obj_type] == "class_type" ||
  2676.                   [[$this ooplType] getType3GL] == "Object"} {
  2677.                   [$proc gencode] append "Set "
  2678.               }
  2679.  
  2680.               [$proc gencode] append [$this getName]
  2681.               [$proc gencode] append " = "
  2682.               [$proc gencode] append [$this getInitialValue]
  2683.               [$proc gencode] append "\n"
  2684.       }
  2685. }
  2686.  
  2687. method VBGDataAttr::generateAccesProcs {this var} {
  2688.         set accessTxt [$this getPropertyValue "attrib_access"]
  2689.         set accessList [split $accessTxt -]
  2690.         set readAccess [lindex $accessList 0]
  2691.         if {$readAccess == ""} {
  2692.                 set readAccess "Public"
  2693.         }
  2694.         set writeAccess [lindex $accessList 1]
  2695.         if {$writeAccess == ""} {
  2696.                 set writeAccess "Public"
  2697.         }
  2698.   
  2699.         set getproc [VBGetProperty new [[$this ooplType] generate]]             
  2700.         set getcode [TextSection new]
  2701.         $getproc gencode $getcode
  2702.         $getproc hasUserSection 0
  2703.         $getproc access $readAccess  
  2704.         $getproc name [$this getName]
  2705.         $getproc refName [$var refName]
  2706.  
  2707.         set setcode [TextSection new]
  2708.  
  2709.         if {[[$this ooplType] get_obj_type] == "class_type" ||
  2710.             [[$this ooplType] getType3GL] == "Object"} {
  2711.               $setcode append "Set "
  2712.               $getcode append "Set "
  2713.               set setproc [VBSetProperty new]             
  2714.         } else {
  2715.               set setproc [VBLetProperty new]             
  2716.         }
  2717.  
  2718.         set arg [VBArgument new [[$this ooplType] generate]]             
  2719.         $arg name "x"
  2720.         $setproc addArg $arg
  2721.         $setproc gencode $setcode
  2722.         $setproc hasUserSection 0
  2723.         $setproc access $writeAccess  
  2724.         $setproc name [$this getName]
  2725.         $setproc refName [$var refName]
  2726.  
  2727.         if {[$setproc refName] != ""} {
  2728.            $setcode append "[$setproc refName]_"
  2729.         }
  2730.         $setcode append "[$var name] = x\n"
  2731.  
  2732.         if {[$getproc refName] != ""} {
  2733.            set addin "[$getproc refName]_[$this getName]"
  2734.         } else {
  2735.            set addin "[$this getName]"
  2736.         }
  2737.         
  2738.         $getcode append "$addin = "
  2739.         $getcode append "${addin}_\n"
  2740.  
  2741.         $var addProc $getproc 
  2742.         $var addProc $setproc 
  2743. }
  2744.  
  2745. method VBGDataAttr::generate {this cl} {
  2746.        if {[$this checkLocalSub] > 0} {
  2747.           return
  2748.        }
  2749.  
  2750.        if {[[$this ooplType] getType3GL] == "enum"} {
  2751.            set enum [VBEnumConstant new $cl]
  2752.            $enum name [$this getName]
  2753.  
  2754.            set comment [VBComment new]
  2755.            $enum comment $comment
  2756.            $comment comment  [$this getPropertyValue "freeText"]
  2757.  
  2758.            if {[$this getPropertyValue "initial_value"] != ""} {
  2759.                 $enum value [$this getPropertyValue "initial_value"]
  2760.                 $enum hasValue 1
  2761.            }
  2762.        } else {
  2763.            set variable [VBVariable new [[$this ooplType] generate]]             
  2764.            $variable name "[$this getName]_"
  2765.  
  2766.            if {![$this isClassFeature]} {
  2767.            $variable defaultValue [$this getInitialValue]
  2768.        }
  2769.  
  2770.            set comment [VBComment new]
  2771.            $variable comment $comment
  2772.            $comment comment  [$this getPropertyValue "freeText"]
  2773.  
  2774.        $variable access "Private"
  2775.  
  2776.            if {[$this isClassFeature]} {
  2777.                 $variable refName [$cl name]
  2778.                 $cl addGlobvar $variable
  2779.            } else {
  2780.                 $cl addUservar $variable
  2781.            }
  2782.  
  2783.  
  2784.            $this generateAccesProcs $variable
  2785.        }
  2786. }
  2787.  
  2788. # Do not delete this line -- regeneration end marker
  2789.  
  2790. if [isCommand CMDataAttr] {
  2791.     Class  VBGDataAttrD : {VBGDataAttr CMDataAttr} {
  2792.     }
  2793. } else {
  2794.     Class VBGDataAttrD : {VBGDataAttr OPDataAttr} {    
  2795.     }
  2796. }
  2797.  
  2798. global mostDerivedOOPL ; set mostDerivedOOPL(OPDataAttr) VBGDataAttrD
  2799.  
  2800. selfPromoter OPDataAttr {this} {
  2801.     VBGDataAttrD promote $this
  2802. }
  2803.  
  2804.  
  2805. #---------------------------------------------------------------------------
  2806. #      File:           @(#)vbggenasso.tcl    /main/titanic/13
  2807.  
  2808.  
  2809. Class VBGGenAssocAttr : {VBGAttribute} {
  2810.     constructor
  2811.     method destructor
  2812.     method check
  2813.     method checkLocal
  2814.     method checkLocalSub
  2815.     method checkContainer
  2816.     method checkLocalContainer
  2817.     method getName
  2818.     method hasContainer
  2819.     method generateContainer
  2820.     method generator
  2821.     attribute _generator
  2822. }
  2823.  
  2824. constructor VBGGenAssocAttr {class this name} {
  2825.     set this [VBGAttribute::constructor $class $this $name]
  2826.     # Start constructor user section
  2827.     # End constructor user section
  2828.     return $this
  2829. }
  2830.  
  2831. method VBGGenAssocAttr::destructor {this} {
  2832.     set ref [$this _generator]
  2833.     if {$ref != ""} {
  2834.         $ref _assocattr ""
  2835.     }
  2836.     # Start destructor user section
  2837.     # End destructor user section
  2838. }
  2839.  
  2840. method VBGGenAssocAttr::check {this} {
  2841.         set errornr [$this checkLocal]
  2842.     if {$errornr == 0} {
  2843.             if {[$this hasContainer]} {
  2844.                     incr errornr [$this checkContainer]
  2845.             } else {
  2846.                    $this setGenerator
  2847.                    incr errornr [[$this generator] check]
  2848.         }
  2849.     }
  2850.         return $errornr
  2851. }
  2852.  
  2853. method VBGGenAssocAttr::checkLocal {this} {
  2854.         set errornr [$this checkLocalSub]
  2855.  
  2856.         if {[[$this ooplType] isA OPBaseType]} {
  2857.                m4_error $W_ASSOCTYPEERR [$this getName] [[$this ooplType] getName]
  2858.                incr errornr 1
  2859.         } else {
  2860.                if {[[$this ooplType] ooplClass] == ""} {
  2861.                     incr errornr 1
  2862.            } else {
  2863.             if {[[$this ooplClass] baseClass] == "Menu"} {
  2864.                        if {[[[$this ooplType] ooplClass] baseClass] != "Menu"} {
  2865.                     m4_error $E_NOTMENU [[$this ooplClass] getName] [[[$this ooplType] ooplClass] getName]
  2866.                        incr errornr 1
  2867.                     set temper [[$this ooplClass] localContainerErrors]
  2868.                     incr temper 1
  2869.                     [$this ooplClass] localContainerErrors $temper
  2870.                 }
  2871.             }
  2872.             if {[[$this ooplClass] baseType] == "LeafControl"} {
  2873.                            m4_error $E_CANTCONT [[$this ooplClass] getName]
  2874.                    incr errornr 1
  2875.                 set temper [[$this ooplClass] localContainerErrors]
  2876.                 incr temper 1
  2877.                 [$this ooplClass] localContainerErrors $temper
  2878.             }
  2879.             if {[[$this ooplClass] baseType] == "Class"} {
  2880.                 if {[[[$this ooplType] ooplClass] baseType] == "LeafControl" ||
  2881.                         [[[$this ooplType] ooplClass] baseType] == "NodeControl"} {
  2882.                             m4_error $E_CANTCONTCONT [[$this ooplClass] getName]
  2883.                         incr errornr 1
  2884.                 }
  2885.             }
  2886.                     if {[[$this ooplClass] baseType] == "NodeControl"} {
  2887.                     if {[[[$this ooplType] ooplClass] baseType] != "NodeControl" && 
  2888.                     [[[$this ooplType] ooplClass] baseType] != "LeafControl"} {
  2889.                                     m4_error $E_ONLYCONT [[$this ooplClass] getName] [[[$this ooplType] ooplClass] getName]
  2890.                            incr errornr 1
  2891.                         set temper [[$this ooplClass] localContainerErrors]
  2892.                         incr temper 1
  2893.                         [$this ooplClass] localContainerErrors $temper
  2894.                     }
  2895.                 }
  2896.            }
  2897.         }
  2898.         return $errornr
  2899. }
  2900.  
  2901. method VBGGenAssocAttr::checkLocalSub {this} {
  2902.     return 0
  2903. }
  2904.  
  2905. method VBGGenAssocAttr::checkContainer {this} {
  2906.         set errornr [$this checkLocalContainer]
  2907.         if {$errornr == 0} {
  2908.             incr errornr [[[$this ooplType] ooplClass] checkContainer]
  2909.         }
  2910.  
  2911.         return $errornr
  2912. }
  2913.  
  2914. method VBGGenAssocAttr::checkLocalContainer {this} {
  2915.         set errornr 0
  2916.         if {[[$this ooplClass] baseType] == "Window" || [[$this ooplClass] baseType] == "NodeControl"} {
  2917.             set number [$this getConstraint]
  2918.             if {$number != ""} {
  2919.                 if {![regexp {^[0-9]+$} $number]} {
  2920.                    m4_error $W_INCORCONTAR [$this getName] [[$this ooplClass] getName]
  2921.            incr errornr 1
  2922.                 } 
  2923.             }
  2924.         }
  2925.         return $errornr
  2926. }
  2927.  
  2928. method VBGGenAssocAttr::getName {this} {
  2929.     if {[$this isLinkAttr]} {
  2930.        if {[$this opposite] != ""} {
  2931.           return "[uncap [[[$this opposite] ooplClass] getName]]of[$this OPGenAssocAttr::getName]"
  2932.        }
  2933.     }
  2934.     return [$this OPGenAssocAttr::getName]
  2935. }
  2936.  
  2937. method VBGGenAssocAttr::hasContainer {this} {
  2938.         set baseType [[[$this ooplType] ooplClass] baseType]
  2939.  
  2940.         if {$baseType == "NodeControl" || $baseType == "LeafControl"} {
  2941.              return 1
  2942.         } else {
  2943.              return 0
  2944.         }
  2945. }
  2946.  
  2947. method VBGGenAssocAttr::generateContainer {this cl} {
  2948.         if {[$this checkLocalContainer] > 0} {
  2949.                 return
  2950.         }
  2951.  
  2952.         [[$this ooplType] ooplClass] generateContainer [$this getName] [$this getConstraint] $cl
  2953. }
  2954.  
  2955. # Do not delete this line -- regeneration end marker
  2956.  
  2957. if [isCommand CMGenAssocAttr] {
  2958.     Class  VBGGenAssocAttrD : {VBGGenAssocAttr CMGenAssocAttr} {
  2959.     }
  2960. } else {
  2961.     Class VBGGenAssocAttrD : {VBGGenAssocAttr OPGenAssocAttr} {    
  2962.     }
  2963. }
  2964.  
  2965. global mostDerivedOOPL ; set mostDerivedOOPL(OPGenAssocAttr) VBGGenAssocAttrD
  2966.  
  2967. selfPromoter OPGenAssocAttr {this} {
  2968.     VBGGenAssocAttrD promote $this
  2969. }
  2970. method VBGGenAssocAttr::generator {this args} {
  2971.     if {$args == ""} {
  2972.         return [$this _generator]
  2973.     }
  2974.     set ref [$this _generator]
  2975.     if {$ref != ""} {
  2976.         $ref _assocattr ""
  2977.     }
  2978.     set obj [lindex $args 0]
  2979.     if {$obj != ""} {
  2980.         $obj _assocattr $this
  2981.     }
  2982.     $this _generator $obj
  2983. }
  2984.  
  2985.  
  2986.  
  2987. #---------------------------------------------------------------------------
  2988. #      File:           @(#)vbgtypedef.tcl    /main/titanic/4
  2989.  
  2990.  
  2991. Class VBGTypeDefType : {VBGClassType} {
  2992.     constructor
  2993.     method destructor
  2994. }
  2995.  
  2996. constructor VBGTypeDefType {class this name} {
  2997.     set this [VBGClassType::constructor $class $this $name]
  2998.     # Start constructor user section
  2999.     # End constructor user section
  3000.     return $this
  3001. }
  3002.  
  3003. method VBGTypeDefType::destructor {this} {
  3004.     # Start destructor user section
  3005.     # End destructor user section
  3006. }
  3007.  
  3008. # Do not delete this line -- regeneration end marker
  3009.  
  3010. if [isCommand CMTypeDefType] {
  3011.     Class  VBGTypeDefTypeD : {VBGTypeDefType CMTypeDefType} {
  3012.     }
  3013. } else {
  3014.     Class VBGTypeDefTypeD : {VBGTypeDefType OPTypeDefType} {    
  3015.     }
  3016. }
  3017.  
  3018. global mostDerivedOOPL ; set mostDerivedOOPL(OPTypeDefType) VBGTypeDefTypeD
  3019.  
  3020. selfPromoter OPTypeDefType {this} {
  3021.     VBGTypeDefTypeD promote $this
  3022. }
  3023.  
  3024.  
  3025. #---------------------------------------------------------------------------
  3026. #      File:           @(#)vbgmanyqua.tcl    /main/titanic/11
  3027.  
  3028.  
  3029. Class VBGManyQual : {VBGQual} {
  3030.     constructor
  3031.     method destructor
  3032.     method generate
  3033.     method generateAdd
  3034.     method generateGet
  3035.     method generateRemove
  3036.     method generateDtor
  3037. }
  3038.  
  3039. constructor VBGManyQual {class this assocattr} {
  3040.     set this [VBGQual::constructor $class $this $assocattr]
  3041.     # Start constructor user section
  3042.     # End constructor user section
  3043.     return $this
  3044. }
  3045.  
  3046. method VBGManyQual::destructor {this} {
  3047.     # Start destructor user section
  3048.     # End destructor user section
  3049.     $this VBGQual::destructor
  3050. }
  3051.  
  3052. method VBGManyQual::generate {this cl} {
  3053.         set type [VBType new]
  3054.         $type name "New ClassSet"
  3055.         set vari [VBVariable new $type]
  3056.         $vari name "[[$this assocattr] getName]_"
  3057.         $cl addAssocvar $vari
  3058.         $vari access "Private"
  3059.         if {[[$this assocattr] opposite] != ""} {
  3060.                 [[$this assocattr] opposite] setGenerator
  3061.         }
  3062.         $this generateGet $vari
  3063.         $this generateAdd $vari
  3064.         $this generateRemove $vari
  3065.         $this generateDtor $cl
  3066. }
  3067.  
  3068. method VBGManyQual::generateAdd {this vari} {
  3069.         if {![$this hasAdd 0]} {
  3070.                 $vari access "Public"
  3071.         }
  3072.         if {![$this hasAdd 1]} {
  3073.                 return
  3074.         }
  3075.         set type [VBType new]
  3076.         $type name [[[[$this assocattr] ooplType] ooplClass] getName]
  3077.         set arg [VBArgument new $type]
  3078.         $arg name "x"
  3079.         set addsub [VBSub new]
  3080.         $addsub addArg $arg
  3081.         set type [VBType new]
  3082.         $type name [[[[$this assocattr] qualifier] ooplType] getType3GL]
  3083.         set arg [VBArgument new $type]
  3084.         $arg name  [[[$this assocattr] qualifier] getName]
  3085.         $addsub addArg $arg
  3086.         if {[[$this assocattr] opposite] != ""} {
  3087.            if {[[[$this assocattr] opposite] getMultiplicity] == "one"} {
  3088.               set type [VBType new]
  3089.               $type name [[[[$this assocattr] qualifier] ooplType] getType3GL]
  3090.               set arg [VBArgument new $type]
  3091.               $arg name  "old_[[[$this assocattr] qualifier] getName]"
  3092.               $arg optional 1
  3093.               $addsub addArg $arg
  3094.            }
  3095.         }
  3096.         set addcode [TextSection new]
  3097.  
  3098.         $addsub gencode $addcode
  3099.         $addsub hasUserSection 0
  3100.         $addsub access [$this hasWrite]
  3101.         $addsub name "Add[cap [[$this assocattr] getName]]"
  3102.  
  3103.         $addcode append "Dim tempSet As ClassSet\n"
  3104.  
  3105.         if {[[$this assocattr] opposite] != ""} {
  3106.             if {[[[$this assocattr] opposite] getMultiplicity] == "one"} {
  3107.                $addcode append "If IsMissing(old_[[[$this assocattr] qualifier] getName]) Then\n"
  3108.                $addcode indent +
  3109.                $addcode append "If Not (x.[[[$this assocattr] opposite] getName]_ Is Nothing) Then\n"
  3110.                $addcode indent +
  3111.                if {[[[$this assocattr] opposite] isMandatory]} {
  3112.                   $addcode append "Set tempSet = x.[[[$this assocattr] opposite] getName]_.[[$this assocattr] getName]_.Item(CStr([[[$this assocattr] qualifier] getName]))\n"
  3113.                } else {
  3114.                   $addcode append "x.[[[$this assocattr] opposite] getName]_.Remove[cap [[$this assocattr] getName]] [[[$this assocattr] qualifier] getName], x\n"
  3115.                }
  3116.                $addcode indent -
  3117.                $addcode append "End If\n"
  3118.                $addcode indent -
  3119.                $addcode append "Else\n"
  3120.                $addcode indent +
  3121.                $addcode append "If Not (x.[[[$this assocattr] opposite] getName]_ Is Nothing) Then\n"
  3122.                $addcode indent +
  3123.                if {[[[$this assocattr] opposite] isMandatory]} {
  3124.                   $addcode append "Set tempSet = x.[[[$this assocattr] opposite] getName]_.[[$this assocattr] getName]_.Item(CStr(old_[[[$this assocattr] qualifier] getName]))\n"
  3125.                } else {
  3126.                   $addcode append "x.[[[$this assocattr] opposite] getName]_.Remove[cap [[$this assocattr] getName]] old_[[[$this assocattr] qualifier] getName], x\n"
  3127.                }
  3128.                $addcode indent -
  3129.                $addcode append "End If\n"
  3130.                $addcode indent -
  3131.                $addcode append "End If\n"
  3132.                if {[[[$this assocattr] opposite] isMandatory]} {
  3133.                   $addcode append "tempSet.Remove x\n"
  3134.                } 
  3135.             }
  3136.             if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {
  3137.                 $addcode append "x.[[[$this assocattr] opposite] getName]_.Add Me\n"
  3138.             } else {
  3139.                 $addcode append "Set x.[[[$this assocattr] opposite] getName]_ = Me\n"
  3140.             }
  3141.         } 
  3142.         $addcode append "If [$vari name].ContainsKey(CStr([[[$this assocattr] qualifier] getName])) Then\n"
  3143.         $addcode indent +
  3144.         $addcode append "Set tempSet = [$vari name].Item(CStr([[[$this assocattr] qualifier] getName]))\n"
  3145.         $addcode indent -
  3146.         $addcode append "Else\n"
  3147.         $addcode indent +
  3148.         $addcode append "Set tempSet = New ClassSet\n"
  3149.         $addcode append "[$vari name].Add tempSet, CStr([[[$this assocattr] qualifier] getName])\n"
  3150.         $addcode indent -
  3151.         $addcode append "End If\n"
  3152.         $addcode append "tempSet.Add x\n"
  3153.  
  3154.         $vari addProc $addsub
  3155. }
  3156.  
  3157. method VBGManyQual::generateGet {this vari} {
  3158.         if {![$this hasGet 0]} {
  3159.                 $vari access "Public"
  3160.         }
  3161.         if {![$this hasGet 1]} {
  3162.                 return
  3163.         }
  3164.         set type [VBType new]
  3165.         $type name "ClassSet"
  3166.         set getproc [VBGetProperty new $type]
  3167.         set getcode [TextSection new]
  3168.         $getproc gencode $getcode
  3169.         $getproc hasUserSection 0
  3170.         $getproc access [$this hasRead]
  3171.         $getproc name [[$this assocattr] getName]
  3172.         $getcode append "If [[$this assocattr] getName]_.ContainsKey(CStr([[[$this assocattr] qualifier] getName])) Then\n"
  3173.         $getcode indent +
  3174.         $getcode append "Set "
  3175.         $getcode append "[[$this assocattr] getName] = "
  3176.         $getcode append "[[$this assocattr] getName]_.Item(CStr([[[$this assocattr] qualifier] getName]))\n"
  3177.         $getcode indent -
  3178.         $getcode append "Else\n"
  3179.         $getcode indent +
  3180.         $getcode append "Set "
  3181.         $getcode append "[[$this assocattr] getName] = Nothing\n"
  3182.         $getcode indent -
  3183.         $getcode append "End If\n"
  3184.         set type [VBType new]
  3185.         $type name [[[[$this assocattr] qualifier] ooplType] getType3GL]
  3186.         set arg [VBArgument new $type]
  3187.         $arg name  [[[$this assocattr] qualifier] getName]
  3188.         $getproc addArg $arg
  3189.         $vari addProc $getproc
  3190. }
  3191.  
  3192. method VBGManyQual::generateRemove {this vari} {
  3193.         if {![$this hasRemove 0]} {
  3194.                 $vari access "Public"
  3195.         }
  3196.         if {![$this hasRemove 1]} {
  3197.                 return
  3198.         }
  3199.         set removesub [VBSub new]
  3200.         set type [VBType new]
  3201.         $type name [[[[$this assocattr] qualifier] ooplType] getType3GL]
  3202.         set arg [VBArgument new $type]
  3203.         $arg name [[[$this assocattr] qualifier] getName]
  3204.         $removesub addArg $arg
  3205.         set type [VBType new]
  3206.         $type name [[[[$this assocattr] ooplType] ooplClass] getName]
  3207.         set arg [VBArgument new $type]
  3208.         $arg name "x"
  3209.         $arg optional 1
  3210.  
  3211.         $removesub addArg $arg
  3212.         set removecode [TextSection new]
  3213.         $removesub gencode $removecode
  3214.         $removesub hasUserSection 0
  3215.         $removesub name "Remove[cap [[$this assocattr] getName]]"
  3216.  
  3217.     if {[$this hasWrite] == "None"} {
  3218.             $removesub access "Private"
  3219.         m4_warning $W_CHANGEDREM [[$this assocattr] getName]
  3220.     } else {
  3221.                $removesub access [$this hasWrite]
  3222.     }
  3223.  
  3224.         $removecode append "Dim tempSet As ClassSet\n"
  3225.         $removecode append "Set tempSet = [$vari name].Item(CStr([[[$this assocattr] qualifier] getName]))\n"
  3226.    
  3227.         $removecode append "If IsMissing(x) Then\n"
  3228.         $removecode indent +
  3229.  
  3230.         $removecode append "Dim temp As [[[[$this assocattr] ooplType] ooplClass] getName]\n"
  3231.         $removecode append "While tempSet.Count > 0\n"
  3232.         $removecode indent +
  3233.         $removecode append "Set temp = tempSet.Item(1)\n"
  3234.  
  3235.         if {[[$this assocattr] opposite] != ""} {
  3236.            if {[[[$this assocattr] opposite] getMultiplicity] == "one"} {
  3237.               $removecode append "Set "
  3238.            }
  3239.            $removecode append "temp.[[[$this assocattr] opposite] getName]_"
  3240.            if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {
  3241.                $removecode append ".Remove Me"
  3242.            } else {
  3243.                $removecode append " = Nothing"
  3244.            }
  3245.            $removecode append "\n"
  3246.         }
  3247.  
  3248.         $removecode append "tempSet.Remove temp\n"
  3249.         $removecode indent -
  3250.         $removecode append "Wend\n"
  3251.         $removecode append "[$vari name].RemoveUsingKey(CStr([[[$this assocattr] qualifier] getName]))\n"
  3252.         $removecode indent -
  3253.         $removecode append "Else\n"
  3254.         $removecode indent +
  3255.  
  3256.         if {[[$this assocattr] opposite] != ""} {
  3257.            if {[[[$this assocattr] opposite] getMultiplicity] == "one"} {
  3258.               $removecode append "Set "
  3259.            }
  3260.            $removecode append "temp.[[[$this assocattr] opposite] getName]_"
  3261.            if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {
  3262.                $removecode append ".Remove Me"
  3263.            } else {
  3264.                $removecode append " = Nothing"
  3265.            }
  3266.            $removecode append "\n"
  3267.         }
  3268.  
  3269.         $removecode append "tempSet.Remove x\n"
  3270.  
  3271.         $removecode append "If tempSet.Count = 0 Then\n"
  3272.         $removecode indent +
  3273.         $removecode append "[$vari name].RemoveUsingKey(CStr([[[$this assocattr] qualifier] getName]))\n"
  3274.         $removecode indent -
  3275.         $removecode append "End If\n"
  3276.  
  3277.         $removecode indent -
  3278.         $removecode append "End If\n"
  3279.  
  3280.         $vari addProc $removesub
  3281. }
  3282.  
  3283. method VBGManyQual::generateDtor {this cl} {
  3284.         if {![$this hasDtor 1]} {
  3285.                 return
  3286.         }
  3287.         if {[[$this assocattr] opposite] != ""} {
  3288.            [[$cl terminate] gencode] append "While [[$this assocattr] getName]_.Count > 0\n"
  3289.            [[$cl terminate] gencode] indent +
  3290.            [[$cl terminate] gencode] append "Remove[cap [[$this assocattr] getName]] [[$this assocattr] getName]_.key(1)\n"
  3291.            [[$cl terminate] gencode] indent -
  3292.            [[$cl terminate] gencode] append "Wend\n"
  3293.         }
  3294. }
  3295.  
  3296. # Do not delete this line -- regeneration end marker
  3297.  
  3298.  
  3299.  
  3300. #---------------------------------------------------------------------------
  3301. #      File:           @(#)vbgonequal.tcl    /main/titanic/10
  3302.  
  3303.  
  3304. Class VBGOneQual : {VBGQual} {
  3305.     constructor
  3306.     method destructor
  3307.     method generate
  3308.     method generateAdd
  3309.     method generateGet
  3310.     method generateRemove
  3311.     method generateDtor
  3312. }
  3313.  
  3314. constructor VBGOneQual {class this assocattr} {
  3315.     set this [VBGQual::constructor $class $this $assocattr]
  3316.     # Start constructor user section
  3317.     # End constructor user section
  3318.     return $this
  3319. }
  3320.  
  3321. method VBGOneQual::destructor {this} {
  3322.     # Start destructor user section
  3323.     # End destructor user section
  3324.     $this VBGQual::destructor
  3325. }
  3326.  
  3327. method VBGOneQual::generate {this cl} {
  3328.         set type [VBType new]
  3329.         $type name "New ClassSet"
  3330.         set vari [VBVariable new $type]
  3331.         $vari name "[[$this assocattr] getName]_"
  3332.         $cl addAssocvar $vari
  3333.         $vari access "Private"
  3334.         if {[[$this assocattr] opposite] != ""} {
  3335.                 [[$this assocattr] opposite] setGenerator
  3336.         if {[[[$this assocattr] opposite] getMultiplicity] == "one"} {
  3337.                 $vari access "Public"
  3338.         }
  3339.         }
  3340.         $this generateGet $vari
  3341.         $this generateAdd $vari
  3342.         $this generateRemove $vari
  3343.         $this generateDtor $cl
  3344. }
  3345.  
  3346. method VBGOneQual::generateAdd {this vari} {
  3347.         if {![$this hasAdd 0]} {
  3348.                 $vari access "Public"
  3349.         }
  3350.         if {![$this hasAdd 1]} {
  3351.                 return
  3352.         }
  3353.         set type [VBType new]
  3354.         $type name [[[[$this assocattr] ooplType] ooplClass] getName]
  3355.         set arg [VBArgument new $type]
  3356.         $arg name "x"
  3357.         set addsub [VBSub new]
  3358.         $addsub addArg $arg
  3359.         set type [VBType new]
  3360.         $type name [[[[$this assocattr] qualifier] ooplType] getType3GL]
  3361.         set arg [VBArgument new $type]
  3362.         $arg name  [[[$this assocattr] qualifier] getName]
  3363.         $addsub addArg $arg
  3364.         if {[[$this assocattr] opposite] != ""} {
  3365.            if {[[[$this assocattr] opposite] getMultiplicity] == "one"} {
  3366.               set type [VBType new]
  3367.               $type name [[[[$this assocattr] qualifier] ooplType] getType3GL]
  3368.               set arg [VBArgument new $type]
  3369.               $arg name  "old_[[[$this assocattr] qualifier] getName]"
  3370.               $arg optional 1
  3371.               $addsub addArg $arg
  3372.            }
  3373.         }
  3374.         set addcode [TextSection new]
  3375.  
  3376.         $addsub gencode $addcode
  3377.         $addsub hasUserSection 0
  3378.         $addsub access [$this hasWrite]
  3379.         $addsub name "Add[cap [[$this assocattr] getName]]"
  3380.  
  3381.         if {[[$this assocattr] isMandatory]} {
  3382.            $addcode append "If Not (x Is Nothing) Then\n"
  3383.            $addcode indent +
  3384.         }
  3385.         if {[[$this assocattr] opposite] != ""} {
  3386.             if {[[[$this assocattr] opposite] getMultiplicity] == "one"} {
  3387.                $addcode append "If IsMissing(old_[[[$this assocattr] qualifier] getName]) Then\n"
  3388.                $addcode indent +
  3389.                $addcode append "If Not (x.[[[$this assocattr] opposite] getName]_ Is Nothing) Then\n"
  3390.                $addcode indent +
  3391.                if {[[[$this assocattr] opposite] isMandatory]} {
  3392.                   $addcode append "x.[[[$this assocattr] opposite] getName]_.[[$this assocattr] getName]_.RemoveUsingKey(CStr([[[$this assocattr] qualifier] getName]))\n"
  3393.                } else {
  3394.                   $addcode append "x.[[[$this assocattr] opposite] getName]_.Remove[cap [[$this assocattr] getName]]([[[$this assocattr] qualifier] getName])\n"
  3395.                }
  3396.                $addcode indent -
  3397.                $addcode append "End If\n"
  3398.                $addcode indent -
  3399.                $addcode append "Else\n"
  3400.                $addcode indent +
  3401.                $addcode append "If Not (x.[[[$this assocattr] opposite] getName]_ Is Nothing) Then\n"
  3402.                $addcode indent +
  3403.                if {[[[$this assocattr] opposite] isMandatory]} {
  3404.                   $addcode append "x.[[[$this assocattr] opposite] getName]_.[[$this assocattr] getName]_.RemoveUsingKey(CStr(old_[[[$this assocattr] qualifier] getName]))\n"
  3405.                } else {
  3406.                   $addcode append "x.[[[$this assocattr] opposite] getName]_.Remove[cap [[$this assocattr] getName]](old_[[[$this assocattr] qualifier] getName])\n"
  3407.                }
  3408.                $addcode indent -
  3409.                $addcode append "End If\n"
  3410.                $addcode indent -
  3411.                $addcode append "End If\n"
  3412.             }
  3413.             if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {
  3414.                 $addcode append "x.[[[$this assocattr] opposite] getName]_.Add Me\n"
  3415.             } else {
  3416.                 $addcode append "Set x.[[[$this assocattr] opposite] getName]_ = Me\n"
  3417.             }
  3418.         } 
  3419.         $addcode append "[$vari name].Add x, CStr([[[$this assocattr] qualifier] getName])\n"
  3420.  
  3421.         if {[[$this assocattr] isMandatory]} {
  3422.            $addcode indent -
  3423.            $addcode append "End If\n"
  3424.         }
  3425.         $vari addProc $addsub
  3426. }
  3427.  
  3428. method VBGOneQual::generateGet {this vari} {
  3429.         if {![$this hasGet 0]} {
  3430.                 $vari access "Public"
  3431.         }
  3432.         if {![$this hasGet 1]} {
  3433.                 return
  3434.         }
  3435.         set type [VBType new]
  3436.         $type name [[[[$this assocattr] ooplType] ooplClass] getName]
  3437.         set getproc [VBGetProperty new $type]
  3438.         set getcode [TextSection new]
  3439.         $getproc gencode $getcode
  3440.         $getproc hasUserSection 0
  3441.         $getproc access [$this hasRead]
  3442.         $getproc name [[$this assocattr] getName]
  3443.         $getcode append "If [[$this assocattr] getName]_.ContainsKey(CStr([[[$this assocattr] qualifier] getName])) Then\n"
  3444.         $getcode indent +
  3445.         $getcode append "Set "
  3446.         $getcode append "[[$this assocattr] getName] = "
  3447.         $getcode append "[[$this assocattr] getName]_.Item(CStr([[[$this assocattr] qualifier] getName]))\n"
  3448.         $getcode indent -
  3449.         $getcode append "Else\n"
  3450.         $getcode indent +
  3451.         $getcode append "Set "
  3452.         $getcode append "[[$this assocattr] getName] = Nothing\n"
  3453.         $getcode indent -
  3454.         $getcode append "End If\n"
  3455.         set type [VBType new]
  3456.         $type name [[[[$this assocattr] qualifier] ooplType] getType3GL]
  3457.         set arg [VBArgument new $type]
  3458.         $arg name  [[[$this assocattr] qualifier] getName]
  3459.         $getproc addArg $arg
  3460.         $vari addProc $getproc
  3461. }
  3462.  
  3463. method VBGOneQual::generateRemove {this vari} {
  3464.         if {![$this hasRemove 0]} {
  3465.                 $vari access "Public"
  3466.         }
  3467.         if {![$this hasRemove 1]} {
  3468.                 return
  3469.         }
  3470.         set removesub [VBSub new]
  3471.         set type [VBType new]
  3472.         $type name [[[[$this assocattr] qualifier] ooplType] getType3GL]
  3473.         set arg [VBArgument new $type]
  3474.         $arg name [[[$this assocattr] qualifier] getName]
  3475.         $removesub addArg $arg
  3476.         set removecode [TextSection new]
  3477.         $removesub gencode $removecode
  3478.         $removesub hasUserSection 0
  3479.         $removesub name "Remove[cap [[$this assocattr] getName]]"
  3480.  
  3481.         if {[$this hasWrite] == "None"} {
  3482.                 $removesub access "Private"
  3483.                 m4_warning $W_CHANGEDREM [[$this assocattr] getName]
  3484.         } else {
  3485.                 $removesub access [$this hasWrite]
  3486.         }
  3487.  
  3488.         $removecode append "Dim temp As [[[[$this assocattr] ooplType] ooplClass] getName]\n"
  3489.         $removecode append "Set temp = [$vari name].Item(CStr([[[$this assocattr] qualifier] getName]))\n"
  3490.  
  3491.         if {[[$this assocattr] opposite] != ""} {
  3492.             $removecode append "[$vari name].RemoveUsingKey(CStr([[[$this assocattr] qualifier] getName]))\n"
  3493.             if {[[[$this assocattr] opposite] getMultiplicity] == "one"} {
  3494.                 $removecode append "Set "
  3495.             }
  3496.             $removecode append "temp.[[[$this assocattr] opposite] getName]_"
  3497.             if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {
  3498.                 $removecode append ".Remove Me"
  3499.             } else {
  3500.                 $removecode append " = Nothing"
  3501.             }
  3502.             $removecode append "\n"
  3503.         } else {
  3504.             $removecode append "[$vari name].RemoveUsingKey(CStr([[[$this assocattr] qualifier] getName]))\n"
  3505.         }
  3506.  
  3507.         $vari addProc $removesub
  3508. }
  3509.  
  3510. method VBGOneQual::generateDtor {this cl} {
  3511.         if {![$this hasDtor 1]} {
  3512.                 return
  3513.         }
  3514.         if {[[$this assocattr] opposite] != ""} {
  3515.            [[$cl terminate] gencode] append "While [[$this assocattr] getName]_.Count > 0\n"
  3516.            [[$cl terminate] gencode] indent +
  3517.            [[$cl terminate] gencode] append "Remove[cap [[$this assocattr] getName]] [[$this assocattr] getName]_.key(1)\n"
  3518.            [[$cl terminate] gencode] indent -
  3519.            [[$cl terminate] gencode] append "Wend\n"
  3520.         }
  3521. }
  3522.  
  3523. # Do not delete this line -- regeneration end marker
  3524.  
  3525.  
  3526.  
  3527. #---------------------------------------------------------------------------
  3528. #      File:           @(#)vbgassocat.tcl    /main/titanic/9
  3529.  
  3530.  
  3531. Class VBGAssocAttr : {VBGGenAssocAttr} {
  3532.     constructor
  3533.     method destructor
  3534.     method setGenerator
  3535.     method generate
  3536. }
  3537.  
  3538. constructor VBGAssocAttr {class this name} {
  3539.     set this [VBGGenAssocAttr::constructor $class $this $name]
  3540.     # Start constructor user section
  3541.     # End constructor user section
  3542.     return $this
  3543. }
  3544.  
  3545. method VBGAssocAttr::destructor {this} {
  3546.     # Start destructor user section
  3547.     # End destructor user section
  3548. }
  3549.  
  3550. method VBGAssocAttr::setGenerator {this} {
  3551.        if {[$this generator] == ""} {
  3552.           if {[$this getMultiplicity]=="one"} {
  3553.                $this generator [VBGAssocOne new $this]
  3554.           } else {
  3555.                $this generator [VBGAssocMany new $this]
  3556.           }
  3557.        }
  3558. }
  3559.  
  3560. method VBGAssocAttr::generate {this cl} {
  3561.         if {[$this checkLocal] > 0} {
  3562.                 return
  3563.         }
  3564.         if {[$this hasContainer]} {
  3565.            $this generateContainer $cl
  3566.         } else {
  3567.        $this setGenerator
  3568.            [$this generator] generate $cl
  3569.         }
  3570. }
  3571.  
  3572. # Do not delete this line -- regeneration end marker
  3573.  
  3574. if [isCommand CMAssocAttr] {
  3575.     Class  VBGAssocAttrD : {VBGAssocAttr CMAssocAttr} {
  3576.     }
  3577. } else {
  3578.     Class VBGAssocAttrD : {VBGAssocAttr OPAssocAttr} {    
  3579.     }
  3580. }
  3581.  
  3582. global mostDerivedOOPL ; set mostDerivedOOPL(OPAssocAttr) VBGAssocAttrD
  3583.  
  3584. selfPromoter OPAssocAttr {this} {
  3585.     VBGAssocAttrD promote $this
  3586. }
  3587.  
  3588.  
  3589. #---------------------------------------------------------------------------
  3590. #      File:           @(#)vbglinkatt.tcl    /main/titanic/8
  3591.  
  3592.  
  3593. Class VBGLinkAttr : {VBGGenAssocAttr} {
  3594.     constructor
  3595.     method destructor
  3596.     method setGenerator
  3597.     method generate
  3598. }
  3599.  
  3600. constructor VBGLinkAttr {class this name} {
  3601.     set this [VBGGenAssocAttr::constructor $class $this $name]
  3602.     # Start constructor user section
  3603.     # End constructor user section
  3604.     return $this
  3605. }
  3606.  
  3607. method VBGLinkAttr::destructor {this} {
  3608.     # Start destructor user section
  3609.     # End destructor user section
  3610. }
  3611.  
  3612. method VBGLinkAttr::setGenerator {this} {
  3613.       if {[$this generator] == ""} {
  3614.           if {[$this getMultiplicity]=="one"} {
  3615.                $this generator [VBGAssocOne new $this]
  3616.           } else {
  3617.                $this generator [VBGAssocMany new $this]
  3618.           }
  3619.       }
  3620. }
  3621.  
  3622. method VBGLinkAttr::generate {this cl} {
  3623.         if {[$this checkLocal] > 0} {
  3624.                 return
  3625.         }
  3626.  
  3627.         if {[$this hasContainer]} {
  3628.            $this generateContainer $cl
  3629.         } else {
  3630.        $this setGenerator
  3631.            [$this generator] generate $cl
  3632.         }
  3633. }
  3634.  
  3635. # Do not delete this line -- regeneration end marker
  3636.  
  3637. if [isCommand CMLinkAttr] {
  3638.     Class  VBGLinkAttrD : {VBGLinkAttr CMLinkAttr} {
  3639.     }
  3640. } else {
  3641.     Class VBGLinkAttrD : {VBGLinkAttr OPLinkAttr} {    
  3642.     }
  3643. }
  3644.  
  3645. global mostDerivedOOPL ; set mostDerivedOOPL(OPLinkAttr) VBGLinkAttrD
  3646.  
  3647. selfPromoter OPLinkAttr {this} {
  3648.     VBGLinkAttrD promote $this
  3649. }
  3650.  
  3651.  
  3652. #---------------------------------------------------------------------------
  3653. #      File:           @(#)vbgqualass.tcl    /main/titanic/9
  3654.  
  3655.  
  3656. Class VBGQualAssocAttr : {VBGGenAssocAttr} {
  3657.     constructor
  3658.     method destructor
  3659.     method checkLocalSub
  3660.     method setGenerator
  3661.     method generate
  3662. }
  3663.  
  3664. constructor VBGQualAssocAttr {class this name} {
  3665.     set this [VBGGenAssocAttr::constructor $class $this $name]
  3666.     # Start constructor user section
  3667.     # End constructor user section
  3668.     return $this
  3669. }
  3670.  
  3671. method VBGQualAssocAttr::destructor {this} {
  3672.     # Start destructor user section
  3673.     # End destructor user section
  3674. }
  3675.  
  3676. method VBGQualAssocAttr::checkLocalSub {this} {
  3677.         set errornr 0
  3678.         if {![[[$this qualifier] ooplType] isA OPBaseType]} {
  3679.            m4_error $E_QUALTYPEWRONG [[$this qualifier] getName] [$this getName]
  3680.            incr errornr 1
  3681.         }
  3682.         return $errornr
  3683. }
  3684.  
  3685. method VBGQualAssocAttr::setGenerator {this} {
  3686.       if {[$this generator] == ""} {
  3687.           if {[$this getMultiplicity]=="one"} {
  3688.                $this generator [VBGOneQual new $this]
  3689.           } else {
  3690.                $this generator [VBGManyQual new $this]
  3691.           }
  3692.       }
  3693. }
  3694.  
  3695. method VBGQualAssocAttr::generate {this cl} {
  3696.         if {[$this checkLocal] > 0} {
  3697.                 return
  3698.         }
  3699.  
  3700.         if {[$this hasContainer]} {
  3701.            $this generateContainer $cl
  3702.         } else {
  3703.        $this setGenerator
  3704.            [$this generator] generate $cl
  3705.         }
  3706. }
  3707.  
  3708. # Do not delete this line -- regeneration end marker
  3709.  
  3710. if [isCommand CMQualAssocAttr] {
  3711.     Class  VBGQualAssocAttrD : {VBGQualAssocAttr CMQualAssocAttr} {
  3712.     }
  3713. } else {
  3714.     Class VBGQualAssocAttrD : {VBGQualAssocAttr OPQualAssocAttr} {    
  3715.     }
  3716. }
  3717.  
  3718. global mostDerivedOOPL ; set mostDerivedOOPL(OPQualAssocAttr) VBGQualAssocAttrD
  3719.  
  3720. selfPromoter OPQualAssocAttr {this} {
  3721.     VBGQualAssocAttrD promote $this
  3722. }
  3723.  
  3724.  
  3725. #---------------------------------------------------------------------------
  3726. #      File:           @(#)vbgquallin.tcl    /main/titanic/9
  3727.  
  3728.  
  3729. Class VBGQualLinkAttr : {VBGGenAssocAttr} {
  3730.     constructor
  3731.     method destructor
  3732.     method checkLocalSub
  3733.     method setGenerator
  3734.     method generate
  3735. }
  3736.  
  3737. constructor VBGQualLinkAttr {class this name} {
  3738.     set this [VBGGenAssocAttr::constructor $class $this $name]
  3739.     # Start constructor user section
  3740.     # End constructor user section
  3741.     return $this
  3742. }
  3743.  
  3744. method VBGQualLinkAttr::destructor {this} {
  3745.     # Start destructor user section
  3746.     # End destructor user section
  3747. }
  3748.  
  3749. method VBGQualLinkAttr::checkLocalSub {this} {
  3750.     set errornr 0
  3751.         if {![[[$this qualifier] ooplType] isA OPBaseType]} {
  3752.            m4_error $E_QUALTYPEWRONG [[$this qualifier] getName] [$this getName]
  3753.            incr errornr 1
  3754.         }
  3755.     return $errornr
  3756. }
  3757.  
  3758. method VBGQualLinkAttr::setGenerator {this} {
  3759.       if {[$this generator] == ""} {
  3760.           if {[$this getMultiplicity]=="one"} {
  3761.                $this generator [VBGOneQual new $this]
  3762.           } else {
  3763.                $this generator [VBGManyQual new $this]
  3764.           }
  3765.       }
  3766. }
  3767.  
  3768. method VBGQualLinkAttr::generate {this cl} {
  3769.         if {[$this checkLocal] > 0} {
  3770.                 return
  3771.         }
  3772.  
  3773.         if {[$this hasContainer]} {
  3774.            $this generateContainer $cl
  3775.         } else {
  3776.        $this setGenerator
  3777.            [$this generator] generate $cl
  3778.         }
  3779. }
  3780.  
  3781. # Do not delete this line -- regeneration end marker
  3782.  
  3783. if [isCommand CMQualLinkAttr] {
  3784.     Class  VBGQualLinkAttrD : {VBGQualLinkAttr CMQualLinkAttr} {
  3785.     }
  3786. } else {
  3787.     Class VBGQualLinkAttrD : {VBGQualLinkAttr OPQualLinkAttr} {    
  3788.     }
  3789. }
  3790.  
  3791. global mostDerivedOOPL ; set mostDerivedOOPL(OPQualLinkAttr) VBGQualLinkAttrD
  3792.  
  3793. selfPromoter OPQualLinkAttr {this} {
  3794.     VBGQualLinkAttrD promote $this
  3795. }
  3796.  
  3797.  
  3798. #---------------------------------------------------------------------------
  3799. #      File:           @(#)vbgreverse.tcl    /main/titanic/8
  3800.  
  3801.  
  3802. Class VBGReverseLinkAttr : {VBGGenAssocAttr} {
  3803.     constructor
  3804.     method destructor
  3805.     method setGenerator
  3806.     method generate
  3807. }
  3808.  
  3809. constructor VBGReverseLinkAttr {class this name} {
  3810.     set this [VBGGenAssocAttr::constructor $class $this $name]
  3811.     # Start constructor user section
  3812.     # End constructor user section
  3813.     return $this
  3814. }
  3815.  
  3816. method VBGReverseLinkAttr::destructor {this} {
  3817.     # Start destructor user section
  3818.     # End destructor user section
  3819. }
  3820.  
  3821. method VBGReverseLinkAttr::setGenerator {this} {
  3822.       if {[$this generator] == ""} {
  3823.           if {[$this getMultiplicity]=="one"} {
  3824.                $this generator [VBGAssocOne new $this]
  3825.           } else {
  3826.                $this generator [VBGAssocOne new $this]
  3827.           }
  3828.       }
  3829. }
  3830.  
  3831. method VBGReverseLinkAttr::generate {this cl} {
  3832.         if {[$this checkLocal] > 0} {
  3833.                 return
  3834.         }
  3835.  
  3836.         if {[$this hasContainer]} {
  3837.            $this generateContainer $cl
  3838.         } else {
  3839.        $this setGenerator
  3840.            [$this generator] generate $cl
  3841.         }
  3842.  
  3843. }
  3844.  
  3845. # Do not delete this line -- regeneration end marker
  3846.  
  3847. if [isCommand CMReverseLinkAttr] {
  3848.     Class  VBGReverseLinkAttrD : {VBGReverseLinkAttr CMReverseLinkAttr} {
  3849.     }
  3850. } else {
  3851.     Class VBGReverseLinkAttrD : {VBGReverseLinkAttr OPReverseLinkAttr} {    
  3852.     }
  3853. }
  3854.  
  3855. global mostDerivedOOPL ; set mostDerivedOOPL(OPReverseLinkAttr) VBGReverseLinkAttrD
  3856.  
  3857. selfPromoter OPReverseLinkAttr {this} {
  3858.     VBGReverseLinkAttrD promote $this
  3859. }
  3860.