home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / vbgrammar.tcl < prev    next >
Text File  |  1997-11-10  |  55KB  |  1,985 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            : vbgrammar.tcl
  17. #       Author          : 
  18. #       Original date   : November 1997
  19. #       Description     : Classes for code generation
  20. #
  21. #---------------------------------------------------------------------------
  22.  
  23. #---------------------------------------------------------------------------
  24. #      File:           @(#)vbcookie.tcl    /main/titanic/5
  25. #---------------------------------------------------------------------------
  26.  
  27. # Start user added include file section
  28. # End user added include file section
  29.  
  30.  
  31. Class VBCookie : {Object} {
  32.     constructor
  33.     method destructor
  34. }
  35.  
  36. global VBCookie::inherAttribs
  37. set VBCookie::inherAttribs "' Inheritance attributes"
  38.  
  39. global VBCookie::events
  40. set VBCookie::events "' Events"
  41.  
  42. global VBCookie::implement0
  43. set VBCookie::implement0 "' Implement this function!"
  44.  
  45. global VBCookie::implement1
  46. set VBCookie::implement1 "'"
  47.  
  48. global VBCookie::startUserSection
  49. set VBCookie::startUserSection "' Start user section"
  50.  
  51. global VBCookie::endUserSection
  52. set VBCookie::endUserSection "' End user section"
  53.  
  54. global VBCookie::assocAttribs
  55. set VBCookie::assocAttribs "' Association attributes"
  56.  
  57. global VBCookie::userDefControl
  58. set VBCookie::userDefControl "' User defined control"
  59.  
  60. global VBCookie::userDefAttribs
  61. set VBCookie::userDefAttribs "' User defined attributes"
  62.  
  63. global VBCookie::userDefMethods
  64. set VBCookie::userDefMethods "' User defined methods"
  65.  
  66. global VBCookie::userDefEnums
  67. set VBCookie::userDefEnums "' User defined Enums"
  68.  
  69. global VBCookie::accessMethods
  70. set VBCookie::accessMethods "' Access methods"
  71.  
  72. global VBCookie::assocMethods
  73. set VBCookie::assocMethods "' Association methods"
  74.  
  75. global VBCookie::classFeatureAttribs
  76. set VBCookie::classFeatureAttribs "' Class feature attributes"
  77.  
  78. global VBCookie::classFeatureMethods
  79. set VBCookie::classFeatureMethods "' Class feature methods"
  80.  
  81. global VBCookie::userAttribDefault
  82. set VBCookie::userAttribDefault "' Has default value "
  83.  
  84.  
  85. constructor VBCookie {class this} {
  86.     set this [Object::constructor $class $this $name]
  87.     # Start constructor user section
  88.     # End constructor user section
  89.     return $this
  90. }
  91.  
  92. method VBCookie::destructor {this} {
  93.     # Start destructor user section
  94.     # End destructor user section
  95. }
  96.  
  97. # Do not delete this line -- regeneration end marker
  98.  
  99. #---------------------------------------------------------------------------
  100. #      File:           @(#)vbargument.tcl    /main/titanic/2
  101. #---------------------------------------------------------------------------
  102.  
  103. # Start user added include file section
  104. # End user added include file section
  105.  
  106.  
  107. Class VBArgument : {GCObject} {
  108.     constructor
  109.     method destructor
  110.     method generate
  111.     attribute optional
  112.     attribute passedBy
  113.     attribute name
  114.     attribute defaultValue
  115.     attribute type
  116. }
  117.  
  118. constructor VBArgument {class this type} {
  119.     set this [GCObject::constructor $class $this]
  120.     $this optional 0
  121.     $this type $type
  122.     # Start constructor user section
  123.         $this passedBy ""
  124.     # End constructor user section
  125.     return $this
  126. }
  127.  
  128. method VBArgument::destructor {this} {
  129.     # Start destructor user section
  130.     # End destructor user section
  131. }
  132.  
  133. method VBArgument::generate {this whole} {
  134.         if {[$this optional]} {$whole append "Optional "}
  135.         if {[$this passedBy] != ""} {
  136.               $whole append [$this passedBy]
  137.               $whole append " "
  138.         }
  139.         $whole append [$this name]
  140.         $whole append " "
  141.         [$this type] generate $whole
  142.         if {[$this defaultValue] != ""} {
  143.               $whole append " = "
  144.               $whole append [$this defaultValue]
  145.         }
  146. }
  147.  
  148. # Do not delete this line -- regeneration end marker
  149.  
  150. #---------------------------------------------------------------------------
  151. #      File:           @(#)vbcomment.tcl    /main/titanic/1
  152. #---------------------------------------------------------------------------
  153.  
  154. # Start user added include file section
  155. # End user added include file section
  156.  
  157.  
  158. Class VBComment : {GCObject} {
  159.     constructor
  160.     method destructor
  161.     method generate
  162.     attribute comment
  163. }
  164.  
  165. constructor VBComment {class this} {
  166.     set this [GCObject::constructor $class $this]
  167.     # Start constructor user section
  168.     # End constructor user section
  169.     return $this
  170. }
  171.  
  172. method VBComment::destructor {this} {
  173.     # Start destructor user section
  174.     # End destructor user section
  175. }
  176.  
  177. method VBComment::generate {this section} {
  178.         if { [string length [$this comment]] > 0 } {
  179.                 set restComment [$this comment]
  180.                 set newlinePos [string first "\n" $restComment ]
  181.                 while {$newlinePos != -1} {
  182.                         set thisline [string range $restComment 0 [expr $newlinePos - 1]]
  183.                         set restComment \
  184.                                 [string range $restComment [expr $newlinePos + 1] end]
  185.                         set newlinePos [string first "\n" $restComment ]
  186.                         $section append "' $thisline\n"
  187.                 }
  188.                 $section append "' $restComment\n"
  189.         }
  190. }
  191.  
  192. # Do not delete this line -- regeneration end marker
  193.  
  194. #---------------------------------------------------------------------------
  195. #      File:           @(#)vbenumcons.tcl    /main/titanic/2
  196. #---------------------------------------------------------------------------
  197.  
  198. # Start user added include file section
  199. # End user added include file section
  200.  
  201.  
  202. Class VBEnumConstant : {GCObject} {
  203.     constructor
  204.     method destructor
  205.     method generate
  206.     method module
  207.     attribute refName
  208.     attribute name
  209.     attribute hasValue
  210.     attribute value
  211.     attribute comment
  212.     attribute _module
  213. }
  214.  
  215. constructor VBEnumConstant {class this module} {
  216.     set this [GCObject::constructor $class $this]
  217.     $this hasValue 0
  218.     $this _module $module
  219.     [$module _constSet] append $this
  220.     # Start constructor user section
  221.     $this comment ""      
  222.     # End constructor user section
  223.     return $this
  224. }
  225.  
  226. method VBEnumConstant::destructor {this} {
  227.     # Start destructor user section
  228.     # End destructor user section
  229. }
  230.  
  231. method VBEnumConstant::generate {this section} {
  232.         if {![$this hasValue]} {
  233.               $this value [[$this module] unique] 
  234.               $this hasValue 1
  235.         }
  236.         
  237.         if {[$this comment] != ""} {
  238.                [$this comment] generate $section
  239.         }
  240.         if {[$this refName] != ""} {
  241.               $section append [$this refName]
  242.               $section append "_"
  243.         }
  244.         $section append [$this name]
  245.         $section append " = "
  246.         $section append [$this value]
  247.         $section append "\n"
  248. }
  249.  
  250. # Do not delete this line -- regeneration end marker
  251.  
  252. method VBEnumConstant::module {this args} {
  253.     if {$args == ""} {
  254.         return [$this _module]
  255.     }
  256.     set ref [$this _module]
  257.     if {$ref != ""} {
  258.         [$ref _constSet] removeValue $this
  259.     }
  260.     set obj [lindex $args 0]
  261.     if {$obj != ""} {
  262.         [$obj _constSet] append $this
  263.     }
  264.     $this _module $obj
  265. }
  266.  
  267. #---------------------------------------------------------------------------
  268. #      File:           @(#)vbfeature.tcl    /main/titanic/1
  269. #---------------------------------------------------------------------------
  270.  
  271. # Start user added include file section
  272. # End user added include file section
  273.  
  274.  
  275. Class VBFeature : {GCObject} {
  276.     constructor
  277.     method destructor
  278.     attribute name
  279.     attribute refName
  280.     attribute access
  281.     attribute comment
  282. }
  283.  
  284. constructor VBFeature {class this} {
  285.     set this [GCObject::constructor $class $this]
  286.     # Start constructor user section
  287.     $this comment ""      
  288.     $this refName ""      
  289.     # End constructor user section
  290.     return $this
  291. }
  292.  
  293. method VBFeature::destructor {this} {
  294.     # Start destructor user section
  295.     # End destructor user section
  296. }
  297.  
  298. # Do not delete this line -- regeneration end marker
  299.  
  300. #---------------------------------------------------------------------------
  301. #      File:           @(#)vbproject.tcl    /main/titanic/1
  302. #---------------------------------------------------------------------------
  303.  
  304. # Start user added include file section
  305. # End user added include file section
  306.  
  307.  
  308. Class VBProject : {GCObject} {
  309.     constructor
  310.     method destructor
  311.     method generate
  312.     method getClassmodule
  313.     method setClassmodule
  314.     method removeClassmodule
  315.     method getForm
  316.     method setForm
  317.     method removeForm
  318.     method getModule
  319.     method setModule
  320.     method removeModule
  321.     attribute name
  322.     attribute mdiform
  323.     attribute classmodule
  324.     attribute form
  325.     attribute module
  326. }
  327.  
  328. constructor VBProject {class this} {
  329.     set this [GCObject::constructor $class $this]
  330.     $this classmodule [Dictionary new]
  331.     $this form [Dictionary new]
  332.     $this module [Dictionary new]
  333.     # Start constructor user section
  334.     # End constructor user section
  335.     return $this
  336. }
  337.  
  338. method VBProject::destructor {this} {
  339.     # Start destructor user section
  340.     # End destructor user section
  341. }
  342.  
  343. method VBProject::generate {this typeToClassDict} {
  344.         $typeToClassDict foreach ooplclass fileDict {
  345.               switch [$ooplclass baseClass] {
  346.                    "Form"    {    
  347.                         if {[[$this form] exists [$ooplclass getName]]} {
  348.                            set formfile [TextSection new]
  349.                            [[$this form] set [$ooplclass getName]] generate $formfile  
  350.                            $fileDict set "frm" $formfile
  351.                            
  352.                            if {[[[$this form] set [$ooplclass getName]] hasExtraModule]} {
  353.                                 set modulefile [TextSection new]
  354.                                 [[$this form] set [$ooplclass getName]] generateExtraModule $modulefile  
  355.                                 $fileDict set "bas" $modulefile
  356.                            }
  357.                         }
  358.                    }
  359.                    "Class"   {    
  360.                         if {[[$this classmodule] exists [$ooplclass getName]]} {
  361.                            set classfile [TextSection new]
  362.                            [[$this classmodule] set [$ooplclass getName]] generate $classfile 
  363.                            $fileDict set "cls" $classfile
  364.  
  365.                            if {[[[$this classmodule] set [$ooplclass getName]] hasExtraModule]} {
  366.                                 set modulefile [TextSection new]
  367.                                 [[$this classmodule] set [$ooplclass getName]] generateExtraModule $modulefile  
  368.                                 $fileDict set "bas" $modulefile
  369.                            }
  370.                         }
  371.                    }
  372.                    "MDIForm" {
  373.                         if {[$this mdiform] != ""} {
  374.                            set mdiformfile [TextSection new]
  375.                            [$this mdiform] generate $mdiformfile  
  376.                            $fileDict set "frm" $mdiformfile
  377.  
  378.                            if {[[$this mdiform] hasExtraModule]} {
  379.                                 set modulefile [TextSection new]
  380.                                 [$this mdiform] generateExtraModule $modulefile  
  381.                                 $fileDict set "bas" $modulefile
  382.                            }
  383.                         }
  384.                    } 
  385.                    "Enum"    { 
  386.                         if {[[$this module] exists [$ooplclass getName]]} {
  387.                             set modulefile [TextSection new]
  388.                             [[$this module] set [$ooplclass getName]] generate $modulefile  
  389.                             $fileDict set "bas" $modulefile
  390.                         }
  391.                    }
  392.              }
  393.        }
  394. }
  395.  
  396. # Do not delete this line -- regeneration end marker
  397.  
  398. method VBProject::getClassmodule {this name} {
  399.     return [[$this classmodule] set $name]
  400. }
  401.  
  402. method VBProject::setClassmodule {this name newClassmodule} {
  403.     [$this classmodule] set $name $newClassmodule
  404. }
  405.  
  406. method VBProject::removeClassmodule {this name} {
  407.     [$this classmodule] unset $name
  408. }
  409.  
  410. method VBProject::getForm {this name} {
  411.     return [[$this form] set $name]
  412. }
  413.  
  414. method VBProject::setForm {this name newForm} {
  415.     [$this form] set $name $newForm
  416. }
  417.  
  418. method VBProject::removeForm {this name} {
  419.     [$this form] unset $name
  420. }
  421.  
  422. method VBProject::getModule {this name} {
  423.     return [[$this module] set $name]
  424. }
  425.  
  426. method VBProject::setModule {this name newModule} {
  427.     [$this module] set $name $newModule
  428. }
  429.  
  430. method VBProject::removeModule {this name} {
  431.     [$this module] unset $name
  432. }
  433.  
  434. #---------------------------------------------------------------------------
  435. #      File:           @(#)vbtype.tcl    /main/titanic/1
  436. #---------------------------------------------------------------------------
  437.  
  438. # Start user added include file section
  439. # End user added include file section
  440.  
  441.  
  442. Class VBType : {GCObject} {
  443.     constructor
  444.     method destructor
  445.     method generate
  446.     attribute name
  447. }
  448.  
  449. constructor VBType {class this} {
  450.     set this [GCObject::constructor $class $this]
  451.     # Start constructor user section
  452.     # End constructor user section
  453.     return $this
  454. }
  455.  
  456. method VBType::destructor {this} {
  457.     # Start destructor user section
  458.     # End destructor user section
  459. }
  460.  
  461. method VBType::generate {this whole} {
  462.         $whole append "As "
  463.         $whole append [$this name] 
  464. }
  465.  
  466. # Do not delete this line -- regeneration end marker
  467.  
  468. #---------------------------------------------------------------------------
  469. #      File:           @(#)vbobject.tcl    /main/titanic/4
  470. #---------------------------------------------------------------------------
  471.  
  472. # Start user added include file section
  473. # End user added include file section
  474.  
  475.  
  476. Class VBObject : {GCObject} {
  477.     constructor
  478.     method destructor
  479.     method addHeader
  480.     attribute name
  481. }
  482.  
  483. constructor VBObject {class this} {
  484.     set this [GCObject::constructor $class $this]
  485.     # Start constructor user section
  486.     # End constructor user section
  487.     return $this
  488. }
  489.  
  490. method VBObject::destructor {this} {
  491.     # Start destructor user section
  492.     # End destructor user section
  493. }
  494.  
  495. method VBObject::addHeader {this fileT section} {
  496.     if {$fileT == "bas"} {
  497.        set filename "[$this name]Extras.$fileT"
  498.     } else {
  499.        set filename "[$this name].$fileT"
  500.     }
  501.     expandHeaderIntoSection $filename $fileT $section
  502. }
  503.  
  504. # Do not delete this line -- regeneration end marker
  505.  
  506. #---------------------------------------------------------------------------
  507. #      File:           @(#)vbprocedur.tcl    /main/titanic/2
  508. #---------------------------------------------------------------------------
  509.  
  510. # Start user added include file section
  511. # End user added include file section
  512.  
  513.  
  514. Class VBProcedure : {VBFeature} {
  515.     constructor
  516.     method destructor
  517.     method generateGenCode
  518.     method generateUserCode
  519.     method generateBegin
  520.     method generateBeginArguments
  521.     method generateBeginSub
  522.     method generateMiddle
  523.     method generateEnd
  524.     method generate
  525.     method addArg
  526.     method removeArg
  527.     attribute procType
  528.     attribute hasUserSection
  529.     attribute userCodeFirst
  530.     attribute usercode
  531.     attribute gencode
  532.     attribute argSet
  533. }
  534.  
  535. constructor VBProcedure {class this} {
  536.     set this [VBFeature::constructor $class $this]
  537.     $this procType "None"
  538.     $this hasUserSection 1
  539.     $this userCodeFirst 0
  540.     $this argSet [List new]
  541.     # Start constructor user section
  542.     $this usercode ""
  543.     $this gencode  ""
  544.     # End constructor user section
  545.     return $this
  546. }
  547.  
  548. method VBProcedure::destructor {this} {
  549.     # Start destructor user section
  550.     # End destructor user section
  551.     $this VBFeature::destructor
  552. }
  553.  
  554. method VBProcedure::generateGenCode {this whole} {
  555.       $whole indent +
  556.       if {[$this gencode] != ""} {
  557.             $whole appendSect [$this gencode] 
  558.       } elseif {![$this hasUserSection] && [$this usercode] == ""} {
  559.             $whole append "${VBCookie::implement0}\n"  
  560.             $whole append "${VBCookie::implement1}\n"  
  561.       }
  562.       $whole indent -
  563. }
  564.  
  565. method VBProcedure::generateUserCode {this whole} {
  566.         if {[$this hasUserSection]} {
  567.               $whole indent +
  568.               $whole append "${VBCookie::startUserSection}\n"  
  569.               $whole indent -
  570.         }
  571.  
  572.         if {[$this usercode] != ""} {
  573.               $whole appendSect [$this usercode]
  574.         }
  575.  
  576.         if {[$this hasUserSection]} {
  577.               $whole indent +
  578.               $whole append "${VBCookie::endUserSection}\n"  
  579.               $whole indent -
  580.         }
  581. }
  582.  
  583. method VBProcedure::generateBegin {this whole} {
  584.         if {[$this comment] != ""} {
  585.               [$this comment] generate $whole
  586.         }
  587.         $whole append [$this access]
  588.         $whole append " "
  589.         $whole append [$this procType]
  590.         $whole append " "
  591.         if {[$this refName] != ""} {
  592.               $whole append [$this refName]
  593.               $whole append "_"
  594.         }
  595.         $whole append [$this name]
  596.         $this generateBeginArguments $whole
  597. }
  598.  
  599. method VBProcedure::generateBeginArguments {this whole} {
  600.         $whole append "("
  601.         set first 1
  602.         [$this argSet] foreach arg {
  603.                 if {$first} {
  604.                         set first 0
  605.                 } else {
  606.                         $whole append ", "
  607.                 }
  608.                 $arg generate $whole
  609.         }
  610.         $whole append ")"
  611. }
  612.  
  613. method VBProcedure::generateBeginSub {this whole} {
  614.         $whole append "\n"
  615. }
  616.  
  617. method VBProcedure::generateMiddle {this whole} {
  618.         if {[$this userCodeFirst]} {
  619.            $this generateUserCode $whole
  620.            $this generateGenCode $whole
  621.         } else {
  622.            $this generateGenCode $whole
  623.            $this generateUserCode $whole
  624.         }
  625. }
  626.  
  627. method VBProcedure::generateEnd {this whole} {
  628.         $whole append "End "
  629.         $whole append [$this procType]
  630.         $whole append "\n\n"
  631. }
  632.  
  633. method VBProcedure::generate {this whole} {
  634.         if {[$this access] != "None"} {
  635.             $this generateBegin $whole
  636.             $this generateBeginSub $whole
  637.             $this generateMiddle $whole
  638.             $this generateEnd $whole
  639.         }
  640. }
  641.  
  642. # Do not delete this line -- regeneration end marker
  643.  
  644. method VBProcedure::addArg {this newArg} {
  645.     [$this argSet] append $newArg
  646.  
  647. }
  648.  
  649. method VBProcedure::removeArg {this oldArg} {
  650.     [$this argSet] removeValue $oldArg
  651. }
  652.  
  653. #---------------------------------------------------------------------------
  654. #      File:           @(#)vbproperty.tcl    /main/titanic/1
  655. #---------------------------------------------------------------------------
  656.  
  657. # Start user added include file section
  658. # End user added include file section
  659.  
  660.  
  661. Class VBProperty : {VBProcedure} {
  662.     constructor
  663.     method destructor
  664.     method generateEnd
  665.     attribute procType
  666.     attribute hasUserSection
  667. }
  668.  
  669. constructor VBProperty {class this} {
  670.     set this [VBProcedure::constructor $class $this]
  671.     $this procType "Property None"
  672.     $this hasUserSection 0
  673.     # Start constructor user section
  674.     # End constructor user section
  675.     return $this
  676. }
  677.  
  678. method VBProperty::destructor {this} {
  679.     # Start destructor user section
  680.     # End destructor user section
  681.     $this VBProcedure::destructor
  682. }
  683.  
  684. method VBProperty::generateEnd {this whole} {
  685.         $whole append "End Property"
  686.         $whole append "\n\n"
  687. }
  688.  
  689. # Do not delete this line -- regeneration end marker
  690.  
  691. #---------------------------------------------------------------------------
  692. #      File:           @(#)vbsetprope.tcl    /main/titanic/1
  693. #---------------------------------------------------------------------------
  694.  
  695. # Start user added include file section
  696. # End user added include file section
  697.  
  698.  
  699. Class VBSetProperty : {VBProperty} {
  700.     constructor
  701.     method destructor
  702.     attribute procType
  703. }
  704.  
  705. constructor VBSetProperty {class this} {
  706.     set this [VBProperty::constructor $class $this]
  707.     $this procType "Property Set"
  708.     # Start constructor user section
  709.     # End constructor user section
  710.     return $this
  711. }
  712.  
  713. method VBSetProperty::destructor {this} {
  714.     # Start destructor user section
  715.     # End destructor user section
  716.     $this VBProperty::destructor
  717. }
  718.  
  719. # Do not delete this line -- regeneration end marker
  720.  
  721. #---------------------------------------------------------------------------
  722. #      File:           @(#)vbgetprope.tcl    /main/titanic/1
  723. #---------------------------------------------------------------------------
  724.  
  725. # Start user added include file section
  726. # End user added include file section
  727.  
  728.  
  729. Class VBGetProperty : {VBProperty} {
  730.     constructor
  731.     method destructor
  732.     method generateBeginSub
  733.     attribute procType
  734.     attribute returnvalue
  735. }
  736.  
  737. constructor VBGetProperty {class this returnvalue} {
  738.     set this [VBProperty::constructor $class $this]
  739.     $this procType "Property Get"
  740.     $this returnvalue $returnvalue
  741.     # Start constructor user section
  742.     # End constructor user section
  743.     return $this
  744. }
  745.  
  746. method VBGetProperty::destructor {this} {
  747.     # Start destructor user section
  748.     # End destructor user section
  749.     $this VBProperty::destructor
  750. }
  751.  
  752. method VBGetProperty::generateBeginSub {this whole} {
  753.          $whole append " "
  754.          [$this returnvalue] generate $whole
  755.          $whole append "\n"
  756. }
  757.  
  758. # Do not delete this line -- regeneration end marker
  759.  
  760. #---------------------------------------------------------------------------
  761. #      File:           @(#)vbvariable.tcl    /main/titanic/3
  762. #---------------------------------------------------------------------------
  763.  
  764. # Start user added include file section
  765. # End user added include file section
  766.  
  767.  
  768. Class VBVariable : {VBFeature} {
  769.     constructor
  770.     method destructor
  771.     method generate
  772.     method generateProcs
  773.     method addProc
  774.     method removeProc
  775.     attribute defaultValue
  776.     attribute procSet
  777.     attribute type
  778. }
  779.  
  780. constructor VBVariable {class this type} {
  781.     set this [VBFeature::constructor $class $this]
  782.     $this type $type
  783.     $this procSet [List new]
  784.     # Start constructor user section
  785.     # End constructor user section
  786.     return $this
  787. }
  788.  
  789. method VBVariable::destructor {this} {
  790.     # Start destructor user section
  791.     # End destructor user section
  792.     $this VBFeature::destructor
  793. }
  794.  
  795. method VBVariable::generate {this whole} {
  796.         if {[$this comment] != ""} {
  797.               [$this comment] generate $whole
  798.         }
  799.         $whole append [$this access]
  800.         $whole append " "
  801.         if {[$this refName] != ""} {
  802.               $whole append [$this refName]
  803.               $whole append "_"
  804.         }
  805.         $whole append [$this name]
  806.         $whole append " "
  807.         [$this type] generate $whole
  808.     if {[$this defaultValue] != ""} {
  809.         $whole append "\n${VBCookie::userAttribDefault}"
  810.         $whole append [$this defaultValue]
  811.     }
  812.         $whole append "\n\n" 
  813. }
  814.  
  815. method VBVariable::generateProcs {this whole} {
  816.         [$this procSet] foreach proc {
  817.                 $proc refName [$this refName]
  818.                 $proc generate $whole
  819.         }
  820. }
  821.  
  822. # Do not delete this line -- regeneration end marker
  823.  
  824. method VBVariable::addProc {this newProc} {
  825.     [$this procSet] append $newProc
  826.  
  827. }
  828.  
  829. method VBVariable::removeProc {this oldProc} {
  830.     [$this procSet] removeValue $oldProc
  831. }
  832.  
  833. #---------------------------------------------------------------------------
  834. #      File:           @(#)vbfunction.tcl    /main/titanic/1
  835. #---------------------------------------------------------------------------
  836.  
  837. # Start user added include file section
  838. # End user added include file section
  839.  
  840.  
  841. Class VBFunction : {VBProcedure} {
  842.     constructor
  843.     method destructor
  844.     method generateBeginSub
  845.     attribute procType
  846.     attribute returnvalue
  847. }
  848.  
  849. constructor VBFunction {class this returnvalue} {
  850.     set this [VBProcedure::constructor $class $this]
  851.     $this procType "Function"
  852.     $this returnvalue $returnvalue
  853.     # Start constructor user section
  854.     # End constructor user section
  855.     return $this
  856. }
  857.  
  858. method VBFunction::destructor {this} {
  859.     # Start destructor user section
  860.     # End destructor user section
  861.     $this VBProcedure::destructor
  862. }
  863.  
  864. method VBFunction::generateBeginSub {this whole} {
  865.       $whole append " "
  866.       [$this returnvalue] generate $whole
  867.       $whole append "\n"
  868. }
  869.  
  870. # Do not delete this line -- regeneration end marker
  871.  
  872. #---------------------------------------------------------------------------
  873. #      File:           @(#)vbsub.tcl    /main/titanic/1
  874. #---------------------------------------------------------------------------
  875.  
  876. # Start user added include file section
  877. # End user added include file section
  878.  
  879.  
  880. Class VBSub : {VBProcedure} {
  881.     constructor
  882.     method destructor
  883.     attribute procType
  884. }
  885.  
  886. constructor VBSub {class this} {
  887.     set this [VBProcedure::constructor $class $this]
  888.     $this procType "Sub"
  889.     # Start constructor user section
  890.     # End constructor user section
  891.     return $this
  892. }
  893.  
  894. method VBSub::destructor {this} {
  895.     # Start destructor user section
  896.     # End destructor user section
  897.     $this VBProcedure::destructor
  898. }
  899.  
  900. # Do not delete this line -- regeneration end marker
  901.  
  902. #---------------------------------------------------------------------------
  903. #      File:           @(#)vbevent.tcl    /main/titanic/1
  904. #---------------------------------------------------------------------------
  905.  
  906. # Start user added include file section
  907. # End user added include file section
  908.  
  909.  
  910. Class VBEvent : {VBSub} {
  911.     constructor
  912.     method destructor
  913.     method generateBeginArguments
  914.     attribute access
  915.     attribute hasIndex
  916. }
  917.  
  918. constructor VBEvent {class this} {
  919.     set this [VBSub::constructor $class $this]
  920.     $this access "Private"
  921.     $this hasIndex 0
  922.     # Start constructor user section
  923.     # End constructor user section
  924.     return $this
  925. }
  926.  
  927. method VBEvent::destructor {this} {
  928.     # Start destructor user section
  929.     # End destructor user section
  930.     $this VBSub::destructor
  931. }
  932.  
  933. method VBEvent::generateBeginArguments {this whole} {
  934.         $whole append "("
  935.  
  936.         if {[$this hasIndex]} {
  937.               $whole append "Index As Integer"
  938.               set first 0
  939.         } else {
  940.               set first 1
  941.         }
  942.  
  943.         [$this argSet] foreach arg {
  944.                 if {$first} {
  945.                         set first 0
  946.                 } else {
  947.                         $whole append ", "
  948.                 }
  949.                 $arg generate $whole
  950.         }
  951.         $whole append ")"
  952. }
  953.  
  954. # Do not delete this line -- regeneration end marker
  955.  
  956. #---------------------------------------------------------------------------
  957. #      File:           @(#)vbunit.tcl    /main/titanic/10
  958. #---------------------------------------------------------------------------
  959.  
  960. # Start user added include file section
  961. # End user added include file section
  962.  
  963.  
  964. Class VBUnit : {VBObject} {
  965.     constructor
  966.     method destructor
  967.     method generateAssocAttribs
  968.     method generateUserDefAttribs
  969.     method generateInherAttribs
  970.     method generateUserDefMethods
  971.     method generateAccessMethods
  972.     method generateAssocMethods
  973.     method generateEvents
  974.     method generateBegin
  975.     method generateEnd
  976.     method generate
  977.     method hasExtraModule
  978.     method generateExtraModule
  979.     method addGlobvar
  980.     method removeGlobvar
  981.     method addAssocvar
  982.     method removeAssocvar
  983.     method addUservar
  984.     method removeUservar
  985.     method addInhervar
  986.     method removeInhervar
  987.     method addUserSproc
  988.     method removeUserSproc
  989.     method addGlobSproc
  990.     method removeGlobSproc
  991.     method getUserproc
  992.     method setUserproc
  993.     method removeUserproc
  994.     method getGlobproc
  995.     method setGlobproc
  996.     method removeGlobproc
  997.     attribute type
  998.     attribute globvarSet
  999.     attribute attribs
  1000.     attribute comment
  1001.     attribute assocvarSet
  1002.     attribute uservarSet
  1003.     attribute inhervarSet
  1004.     attribute userSprocSet
  1005.     attribute globSprocSet
  1006.     attribute constructor
  1007.     attribute terminate
  1008.     attribute userproc
  1009.     attribute globproc
  1010. }
  1011.  
  1012. constructor VBUnit {class this} {
  1013.     set this [VBObject::constructor $class $this]
  1014.     $this type "None"
  1015.     $this globvarSet [List new]
  1016.     $this assocvarSet [List new]
  1017.     $this uservarSet [List new]
  1018.     $this inhervarSet [List new]
  1019.     $this userSprocSet [List new]
  1020.     $this globSprocSet [List new]
  1021.     $this userproc [Dictionary new]
  1022.     $this globproc [Dictionary new]
  1023.     # Start constructor user section
  1024.     # End constructor user section
  1025.     return $this
  1026. }
  1027.  
  1028. method VBUnit::destructor {this} {
  1029.     # Start destructor user section
  1030.     # End destructor user section
  1031.     $this VBObject::destructor
  1032. }
  1033.  
  1034. method VBUnit::generateAssocAttribs {this section} {
  1035.         $section append "\n${VBCookie::assocAttribs}\n\n"
  1036.  
  1037.         [$this assocvarSet] foreach assocvar {
  1038.                 $assocvar generate $section
  1039.         }
  1040. }
  1041.  
  1042. method VBUnit::generateUserDefAttribs {this section} {
  1043.         $section append "\n${VBCookie::userDefAttribs}\n\n"
  1044.  
  1045.         [$this uservarSet] foreach uservar {
  1046.                 $uservar generate $section
  1047.         }
  1048. }
  1049.  
  1050. method VBUnit::generateInherAttribs {this section} {
  1051. }
  1052.  
  1053. method VBUnit::generateUserDefMethods {this section} {
  1054.         $section append "\n${VBCookie::userDefMethods}\n\n"
  1055.  
  1056.         if {[$this constructor] != ""} {
  1057.                 [$this constructor] refName  [$this name]
  1058.                 [$this constructor] generate $section
  1059.         }
  1060.  
  1061.         if {[$this terminate] != ""} {
  1062.                 [$this terminate] refName  [$this type]
  1063.                 [$this terminate] generate $section
  1064.         }
  1065.  
  1066.         [$this userSprocSet] foreach userproc {
  1067.                 $userproc generate $section
  1068.         }
  1069. }
  1070.  
  1071. method VBUnit::generateAccessMethods {this section} {
  1072.         $section append "\n${VBCookie::accessMethods}\n\n"
  1073.  
  1074.         [$this uservarSet] foreach uservar {
  1075.                 $uservar generateProcs $section
  1076.         }
  1077.  
  1078.         [$this globvarSet] foreach globvar {
  1079.                 $globvar generateProcs $section
  1080.         }
  1081. }
  1082.  
  1083. method VBUnit::generateAssocMethods {this section} {
  1084.         $section append "\n${VBCookie::assocMethods}\n\n"
  1085.  
  1086.         [$this assocvarSet] foreach assocvar {
  1087.                 $assocvar generateProcs $section
  1088.         }
  1089. }
  1090.  
  1091. method VBUnit::generateEvents {this section} {
  1092. }
  1093.  
  1094. method VBUnit::generateBegin {this section} {
  1095.         $section append "NONE\n"
  1096. }
  1097.  
  1098. method VBUnit::generateEnd {this section} {
  1099.         $this generateInherAttribs $section
  1100.     $this generateAssocAttribs $section
  1101.     $this generateUserDefAttribs $section
  1102.     $this generateUserDefMethods $section
  1103.     $this generateEvents $section
  1104.     $this generateAccessMethods $section
  1105.     $this generateAssocMethods $section
  1106. }
  1107.  
  1108. method VBUnit::generate {this section} {
  1109.         $this generateBegin $section
  1110.         $this generateEnd   $section
  1111. }
  1112.  
  1113. method VBUnit::hasExtraModule {this} {
  1114.         if {[[$this globvarSet] empty]} {
  1115.            if {[[$this globproc] size] == 0} {
  1116.               return 0
  1117.            }
  1118.         }
  1119.         return 1 
  1120. }
  1121.  
  1122. method VBUnit::generateExtraModule {this section} {
  1123.         $section append "Attribute VB_Name = \""
  1124.         $section append [$this name]
  1125.         $section append "Extras\"\n"
  1126.      $this addHeader bas $section
  1127.         $section append "Option Explicit\n"
  1128.  
  1129.         $section append "\n${VBCookie::classFeatureAttribs}\n\n"
  1130.         [$this globvarSet] foreach globalvar {
  1131.                 $globalvar refName [$this name]
  1132.                 $globalvar access "Public"
  1133.                 $globalvar generate $section
  1134.         }
  1135.  
  1136.         $section append "\n\n${VBCookie::classFeatureMethods}\n\n"
  1137.         [$this globSprocSet] foreach globalproc {
  1138.                 $globalproc refName [$this name]
  1139.                 $globalproc access "Public"
  1140.                 $globalproc generate $section
  1141.         }
  1142. }
  1143.  
  1144. # Do not delete this line -- regeneration end marker
  1145.  
  1146. method VBUnit::addGlobvar {this newGlobvar} {
  1147.     [$this globvarSet] append $newGlobvar
  1148.  
  1149. }
  1150.  
  1151. method VBUnit::removeGlobvar {this oldGlobvar} {
  1152.     [$this globvarSet] removeValue $oldGlobvar
  1153. }
  1154.  
  1155. method VBUnit::addAssocvar {this newAssocvar} {
  1156.     [$this assocvarSet] append $newAssocvar
  1157.  
  1158. }
  1159.  
  1160. method VBUnit::removeAssocvar {this oldAssocvar} {
  1161.     [$this assocvarSet] removeValue $oldAssocvar
  1162. }
  1163.  
  1164. method VBUnit::addUservar {this newUservar} {
  1165.     [$this uservarSet] append $newUservar
  1166.  
  1167. }
  1168.  
  1169. method VBUnit::removeUservar {this oldUservar} {
  1170.     [$this uservarSet] removeValue $oldUservar
  1171. }
  1172.  
  1173. method VBUnit::addInhervar {this newInhervar} {
  1174.     [$this inhervarSet] append $newInhervar
  1175.  
  1176. }
  1177.  
  1178. method VBUnit::removeInhervar {this oldInhervar} {
  1179.     [$this inhervarSet] removeValue $oldInhervar
  1180. }
  1181.  
  1182. method VBUnit::addUserSproc {this newUserSproc} {
  1183.     [$this userSprocSet] append $newUserSproc
  1184.  
  1185. }
  1186.  
  1187. method VBUnit::removeUserSproc {this oldUserSproc} {
  1188.     [$this userSprocSet] removeValue $oldUserSproc
  1189. }
  1190.  
  1191. method VBUnit::addGlobSproc {this newGlobSproc} {
  1192.     [$this globSprocSet] append $newGlobSproc
  1193.  
  1194. }
  1195.  
  1196. method VBUnit::removeGlobSproc {this oldGlobSproc} {
  1197.     [$this globSprocSet] removeValue $oldGlobSproc
  1198. }
  1199.  
  1200. method VBUnit::getUserproc {this name} {
  1201.     return [[$this userproc] set $name]
  1202. }
  1203.  
  1204. method VBUnit::setUserproc {this name newUserproc} {
  1205.     [$this userproc] set $name $newUserproc
  1206. }
  1207.  
  1208. method VBUnit::removeUserproc {this name} {
  1209.     [$this userproc] unset $name
  1210. }
  1211.  
  1212. method VBUnit::getGlobproc {this name} {
  1213.     return [[$this globproc] set $name]
  1214. }
  1215.  
  1216. method VBUnit::setGlobproc {this name newGlobproc} {
  1217.     [$this globproc] set $name $newGlobproc
  1218. }
  1219.  
  1220. method VBUnit::removeGlobproc {this name} {
  1221.     [$this globproc] unset $name
  1222. }
  1223.  
  1224. #---------------------------------------------------------------------------
  1225. #      File:           @(#)vbclassmod.tcl    /main/titanic/7
  1226. #---------------------------------------------------------------------------
  1227.  
  1228. # Start user added include file section
  1229. # End user added include file section
  1230.  
  1231.  
  1232. Class VBClassModule : {VBUnit} {
  1233.     constructor
  1234.     method destructor
  1235.     method generateInherAttribs
  1236.     method generateBegin
  1237.     attribute type
  1238. }
  1239.  
  1240. constructor VBClassModule {class this} {
  1241.     set this [VBUnit::constructor $class $this]
  1242.     $this type "Class"
  1243.     # Start constructor user section
  1244.     # End constructor user section
  1245.     return $this
  1246. }
  1247.  
  1248. method VBClassModule::destructor {this} {
  1249.     # Start destructor user section
  1250.     # End destructor user section
  1251.     $this VBUnit::destructor
  1252. }
  1253.  
  1254. method VBClassModule::generateInherAttribs {this section} {
  1255.         $section append "\n${VBCookie::inherAttribs}\n\n"
  1256.  
  1257.         [$this inhervarSet] foreach inhervar {
  1258.                 $inhervar generate $section
  1259.         }
  1260. }
  1261.  
  1262. method VBClassModule::generateBegin {this section} {
  1263.         $section append "VERSION 1.0 CLASS\n"
  1264.         $section append "BEGIN\n"
  1265.         $section append "  MultiUse = -1  'True\n"
  1266.         $section append "END\n"
  1267.         if {[$this attribs] == ""} {
  1268.                $section append "Attribute VB_Name = \""
  1269.                $section append [$this name]
  1270.                $section append "\"\n"
  1271.         } else {
  1272.                $section appendSect [$this attribs] 
  1273.         }
  1274.     $this addHeader cls $section
  1275.         if {[$this comment] != ""} {
  1276.               [$this comment] generate $section
  1277.         }
  1278.         $section append "Option Explicit\n\n"
  1279. }
  1280.  
  1281. # Do not delete this line -- regeneration end marker
  1282.  
  1283. #---------------------------------------------------------------------------
  1284. #      File:           @(#)vbcontaine.tcl    /main/titanic/5
  1285. #---------------------------------------------------------------------------
  1286.  
  1287. # Start user added include file section
  1288. # End user added include file section
  1289.  
  1290.  
  1291. Class VBContainer : {VBObject} {
  1292.     constructor
  1293.     method destructor
  1294.     method generateIndex
  1295.     method generateMiddle
  1296.     method generate
  1297.     method generateRemarks
  1298.     method generateEvents
  1299.     method addSevent
  1300.     method removeSevent
  1301.     method getEvent
  1302.     method setEvent
  1303.     method removeEvent
  1304.     attribute ofClass
  1305.     attribute guiType
  1306.     attribute guiLib
  1307.     attribute hasIndex
  1308.     attribute indexInSpecs
  1309.     attribute index
  1310.     attribute specs
  1311.     attribute SeventSet
  1312.     attribute event
  1313. }
  1314.  
  1315. constructor VBContainer {class this} {
  1316.     set this [VBObject::constructor $class $this]
  1317.     $this guiLib "VB"
  1318.     $this hasIndex 0
  1319.     $this indexInSpecs 0
  1320.     $this SeventSet [List new]
  1321.     $this event [Dictionary new]
  1322.     # Start constructor user section
  1323.     $this specs ""     
  1324.     # End constructor user section
  1325.     return $this
  1326. }
  1327.  
  1328. method VBContainer::destructor {this} {
  1329.     # Start destructor user section
  1330.     # End destructor user section
  1331.     $this VBObject::destructor
  1332. }
  1333.  
  1334. method VBContainer::generateIndex {this section} {
  1335.         if {[$this hasIndex] && ![$this indexInSpecs]} {
  1336.               $section append "Index           =   "
  1337.               $section append [$this index]
  1338.               $section append "\n"                  
  1339.         }
  1340. }
  1341.  
  1342. method VBContainer::generateMiddle {this section} {
  1343.         $section append "NONE\n"
  1344. }
  1345.  
  1346. method VBContainer::generate {this section} {
  1347.         $section append "Begin "
  1348.         $section append [$this guiLib]
  1349.         $section append "."           
  1350.         $section append [$this guiType]
  1351.         $section append " "           
  1352.         $section append [$this name]
  1353.         $section append "\n"           
  1354.  
  1355.         if {[$this specs] != ""} {
  1356.               $section pushIndent 1
  1357.               $section appendSect [$this specs] 
  1358.               $section popIndent
  1359.         }
  1360.         $section indent +
  1361.         $this generateIndex $section
  1362.         $section indent -
  1363.  
  1364.         $section indent +
  1365.         $this generateMiddle $section 
  1366.         $section indent -
  1367.  
  1368.         $section append "End\n"      
  1369. }
  1370.  
  1371. method VBContainer::generateRemarks {this section} {
  1372.     $section append "${VBCookie::userDefControl} [$this name] of [$this ofClass]\n"
  1373. }
  1374.  
  1375. method VBContainer::generateEvents {this section} {
  1376.         [$this SeventSet] foreach eventval {
  1377.                 $eventval refName [$this name]
  1378.                 $eventval hasIndex [$this hasIndex]
  1379.                 $eventval generate $section
  1380.         }
  1381. }
  1382.  
  1383. # Do not delete this line -- regeneration end marker
  1384.  
  1385. method VBContainer::addSevent {this newSevent} {
  1386.     [$this SeventSet] append $newSevent
  1387.  
  1388. }
  1389.  
  1390. method VBContainer::removeSevent {this oldSevent} {
  1391.     [$this SeventSet] removeValue $oldSevent
  1392. }
  1393.  
  1394. method VBContainer::getEvent {this name} {
  1395.     return [[$this event] set $name]
  1396. }
  1397.  
  1398. method VBContainer::setEvent {this name newEvent} {
  1399.     [$this event] set $name $newEvent
  1400. }
  1401.  
  1402. method VBContainer::removeEvent {this name} {
  1403.     [$this event] unset $name
  1404. }
  1405.  
  1406. #---------------------------------------------------------------------------
  1407. #      File:           @(#)vbcontrol.tcl    /main/titanic/2
  1408. #---------------------------------------------------------------------------
  1409.  
  1410. # Start user added include file section
  1411. # End user added include file section
  1412.  
  1413.  
  1414. Class VBControl : {VBContainer} {
  1415.     constructor
  1416.     method destructor
  1417.     method getContainers
  1418.     method addContain
  1419.     method generateMiddle
  1420.     method addSubcontrol
  1421.     method removeSubcontrol
  1422.     attribute subcontrolSet
  1423. }
  1424.  
  1425. constructor VBControl {class this} {
  1426.     set this [VBContainer::constructor $class $this]
  1427.     $this subcontrolSet [List new]
  1428.     # Start constructor user section
  1429.     # End constructor user section
  1430.     return $this
  1431. }
  1432.  
  1433. method VBControl::destructor {this} {
  1434.     # Start destructor user section
  1435.     # End destructor user section
  1436.     $this VBContainer::destructor
  1437. }
  1438.  
  1439. method VBControl::getContainers {this frm} {
  1440.         $frm addContainer $this
  1441.         [$this subcontrolSet] foreach subcontrol {
  1442.                 $subcontrol getContainers $frm
  1443.         }
  1444. }
  1445.  
  1446. method VBControl::addContain {this cl} {
  1447.     $this addSubcontrol $cl         
  1448. }
  1449.  
  1450. method VBControl::generateMiddle {this section} {
  1451.         [$this subcontrolSet] foreach subcontrol {
  1452.                 $subcontrol generate $section
  1453.         }
  1454. }
  1455.  
  1456. # Do not delete this line -- regeneration end marker
  1457.  
  1458. method VBControl::addSubcontrol {this newSubcontrol} {
  1459.     [$this subcontrolSet] append $newSubcontrol
  1460.  
  1461. }
  1462.  
  1463. method VBControl::removeSubcontrol {this oldSubcontrol} {
  1464.     [$this subcontrolSet] removeValue $oldSubcontrol
  1465. }
  1466.  
  1467. #---------------------------------------------------------------------------
  1468. #      File:           @(#)vbform.tcl    /main/titanic/14
  1469. #---------------------------------------------------------------------------
  1470.  
  1471. # Start user added include file section
  1472. # End user added include file section
  1473.  
  1474.  
  1475. Class VBForm : {VBUnit} {
  1476.     constructor
  1477.     method destructor
  1478.     method addContain
  1479.     method checkSynonyms
  1480.     method removeDuplicates
  1481.     method setIndices
  1482.     method configur
  1483.     method generateControls
  1484.     method generateControlRemarks
  1485.     method generateMenus
  1486.     method generateBegin
  1487.     method generateEvents
  1488.     method addContainer
  1489.     method removeContainer
  1490.     method addControl
  1491.     method removeControl
  1492.     method addMenu
  1493.     method removeMenu
  1494.     method addSortedmenu
  1495.     method removeSortedmenu
  1496.     method addSevent
  1497.     method removeSevent
  1498.     method getEvent
  1499.     method setEvent
  1500.     method removeEvent
  1501.     attribute type
  1502.     attribute objects
  1503.     attribute specs
  1504.     attribute containerSet
  1505.     attribute controlSet
  1506.     attribute menuSet
  1507.     attribute sortedmenuSet
  1508.     attribute SeventSet
  1509.     attribute event
  1510. }
  1511.  
  1512. constructor VBForm {class this} {
  1513.     set this [VBUnit::constructor $class $this]
  1514.     $this type "Form"
  1515.     $this containerSet [List new]
  1516.     $this controlSet [List new]
  1517.     $this menuSet [List new]
  1518.     $this sortedmenuSet [List new]
  1519.     $this SeventSet [List new]
  1520.     $this event [Dictionary new]
  1521.     # Start constructor user section
  1522.         $this specs ""
  1523.     # End constructor user section
  1524.     return $this
  1525. }
  1526.  
  1527. method VBForm::destructor {this} {
  1528.     # Start destructor user section
  1529.     # End destructor user section
  1530.     $this VBUnit::destructor
  1531. }
  1532.  
  1533. method VBForm::addContain {this cl} {
  1534.         if {[$cl guiType] == "Menu"} {
  1535.             $this addMenu $cl
  1536.         } else {
  1537.             $this addControl $cl
  1538.         }
  1539. }
  1540.  
  1541. method VBForm::checkSynonyms {this} {
  1542.         set SynonymsDict [Dictionary new]
  1543.  
  1544.         [$this containerSet] foreach container {
  1545.              if {[$SynonymsDict exists [$container name]]} {
  1546.                   set group [$SynonymsDict set [$container name]]
  1547.                   $group foreach other {
  1548.                       $this removeDuplicates $container $other
  1549.                   }
  1550.              } else {
  1551.                   set group [List new]
  1552.                   $SynonymsDict set [$container name] $group
  1553.              }
  1554.              $group append $container
  1555.         }
  1556.  
  1557.         [$this containerSet] foreach container {
  1558.              if {[[$SynonymsDict set [$container name]] length] > 1} {
  1559.                   $container hasIndex 1          
  1560.              }
  1561.         }
  1562. }
  1563.  
  1564. method VBForm::removeDuplicates {this first second} {
  1565.     [$first event] foreach evntname evnt {
  1566.              if {[[$second event] exists $evntname]} {
  1567.           $second removeSevent [$second getEvent $evntname]
  1568.                   $second removeEvent $evntname
  1569.              }
  1570.         }
  1571. }
  1572.  
  1573. method VBForm::setIndices {this} {
  1574.         set indexContainerDict [Dictionary new]
  1575.  
  1576.         [$this containerSet] foreach container {
  1577.              if {![$indexContainerDict exists [$container name]]} {
  1578.                    $indexContainerDict set [$container name] [Dictionary new]
  1579.              }
  1580.              if {[$container hasIndex] && [$container index] != ""} {
  1581.                 [$indexContainerDict set [$container name]] set [$container index] [$container index] 
  1582.              }
  1583.         }
  1584.  
  1585.         [$this containerSet] foreach container {
  1586.              if {[$container hasIndex] && [$container index] == ""} {
  1587.                 set indx  0
  1588.                 set found 0
  1589.                 while {!$found} {
  1590.                      if {![[$indexContainerDict set [$container name]] exists $indx]} {
  1591.                            set found 1                                                 
  1592.                      } else {
  1593.                            incr indx
  1594.                      }
  1595.                 }
  1596.                 [$indexContainerDict set [$container name]] set $indx $indx 
  1597.                 $container index $indx 
  1598.              }
  1599.         }
  1600. }
  1601.  
  1602. method VBForm::configur {this} {
  1603.         if {[[$this containerSet] empty]} {
  1604.                [$this sortedmenuSet] foreach sortedmenu {
  1605.                       $sortedmenu getContainers $this
  1606.                }
  1607.                [$this menuSet] foreach menu {
  1608.                       $menu getContainers $this
  1609.                }
  1610.                [$this controlSet] foreach control {
  1611.                        $control getContainers $this
  1612.                }
  1613.         }
  1614.         $this checkSynonyms
  1615. }
  1616.  
  1617. method VBForm::generateControls {this section} {
  1618.         [$this controlSet] foreach control {
  1619.                 $control generate $section
  1620.         }
  1621. }
  1622.  
  1623. method VBForm::generateControlRemarks {this section} {
  1624.         [$this containerSet] foreach control {
  1625.                 $control generateRemarks $section
  1626.         }
  1627. }
  1628.  
  1629. method VBForm::generateMenus {this section} {
  1630.         [$this sortedmenuSet] foreach sortedmenu {
  1631.                $sortedmenu generate $section
  1632.         }
  1633.         [$this menuSet] foreach menu {
  1634.                $menu generate $section
  1635.         }
  1636. }
  1637.  
  1638. method VBForm::generateBegin {this section} {
  1639.         $section append "VERSION 5.00\n"
  1640.         if {[$this objects] != ""} {
  1641.                $section appendSect [$this objects] 
  1642.         }
  1643.         $section append "Begin VB."
  1644.         $section append [$this type]
  1645.         $section append " "
  1646.         $section append [$this name]
  1647.         $section append " \n"
  1648.  
  1649.         if {[$this specs] != ""} {
  1650.                $section appendSect [$this specs] 
  1651.         }
  1652.  
  1653.         $this configur
  1654.         $this setIndices
  1655.  
  1656.     set temp [$section indentString]
  1657.     $section indentString "   "
  1658.  
  1659.         $section indent +
  1660.         $this generateControls $section
  1661.         $this generateMenus $section
  1662.         $section indent -
  1663.  
  1664.     $section indentString $temp
  1665.  
  1666.         $section append "End\n"
  1667.  
  1668.         if {[$this attribs] != ""} {
  1669.                $section appendSect [$this attribs] 
  1670.         } else {
  1671.                $section append "Attribute VB_Name = \""
  1672.                $section append [$this name]
  1673.                $section append "\"\n"
  1674.         }
  1675.     $this addHeader frm $section
  1676.         $this generateControlRemarks $section
  1677.         if {[$this comment] != ""} {
  1678.               [$this comment] generate $section
  1679.         }
  1680.         $section append "Option Explicit\n\n"
  1681. }
  1682.  
  1683. method VBForm::generateEvents {this section} {
  1684.         $section append "\n${VBCookie::events}\n\n"
  1685.  
  1686.         [$this SeventSet] foreach eventval {
  1687.                 $eventval refName [$this type]
  1688.                 $eventval generate $section
  1689.         }
  1690.         [$this containerSet] foreach container {
  1691.                 $container generateEvents $section
  1692.         }
  1693. }
  1694.  
  1695. # Do not delete this line -- regeneration end marker
  1696.  
  1697. method VBForm::addContainer {this newContainer} {
  1698.     [$this containerSet] append $newContainer
  1699.  
  1700. }
  1701.  
  1702. method VBForm::removeContainer {this oldContainer} {
  1703.     [$this containerSet] removeValue $oldContainer
  1704. }
  1705.  
  1706. method VBForm::addControl {this newControl} {
  1707.     [$this controlSet] append $newControl
  1708.  
  1709. }
  1710.  
  1711. method VBForm::removeControl {this oldControl} {
  1712.     [$this controlSet] removeValue $oldControl
  1713. }
  1714.  
  1715. method VBForm::addMenu {this newMenu} {
  1716.     [$this menuSet] append $newMenu
  1717.  
  1718. }
  1719.  
  1720. method VBForm::removeMenu {this oldMenu} {
  1721.     [$this menuSet] removeValue $oldMenu
  1722. }
  1723.  
  1724. method VBForm::addSortedmenu {this newSortedmenu} {
  1725.     [$this sortedmenuSet] append $newSortedmenu
  1726.  
  1727. }
  1728.  
  1729. method VBForm::removeSortedmenu {this oldSortedmenu} {
  1730.     [$this sortedmenuSet] removeValue $oldSortedmenu
  1731. }
  1732.  
  1733. method VBForm::addSevent {this newSevent} {
  1734.     [$this SeventSet] append $newSevent
  1735.  
  1736. }
  1737.  
  1738. method VBForm::removeSevent {this oldSevent} {
  1739.     [$this SeventSet] removeValue $oldSevent
  1740. }
  1741.  
  1742. method VBForm::getEvent {this name} {
  1743.     return [[$this event] set $name]
  1744. }
  1745.  
  1746. method VBForm::setEvent {this name newEvent} {
  1747.     [$this event] set $name $newEvent
  1748. }
  1749.  
  1750. method VBForm::removeEvent {this name} {
  1751.     [$this event] unset $name
  1752. }
  1753.  
  1754. #---------------------------------------------------------------------------
  1755. #      File:           @(#)vbmdiform.tcl    /main/titanic/1
  1756. #---------------------------------------------------------------------------
  1757.  
  1758. # Start user added include file section
  1759. # End user added include file section
  1760.  
  1761.  
  1762. Class VBMDIForm : {VBForm} {
  1763.     constructor
  1764.     method destructor
  1765.     attribute type
  1766. }
  1767.  
  1768. constructor VBMDIForm {class this} {
  1769.     set this [VBForm::constructor $class $this]
  1770.     $this type "MDIForm"
  1771.     # Start constructor user section
  1772.     # End constructor user section
  1773.     return $this
  1774. }
  1775.  
  1776. method VBMDIForm::destructor {this} {
  1777.     # Start destructor user section
  1778.     # End destructor user section
  1779.     $this VBForm::destructor
  1780. }
  1781.  
  1782. # Do not delete this line -- regeneration end marker
  1783.  
  1784. #---------------------------------------------------------------------------
  1785. #      File:           @(#)vbenummodu.tcl    /main/titanic/6
  1786. #---------------------------------------------------------------------------
  1787.  
  1788. # Start user added include file section
  1789. # End user added include file section
  1790.  
  1791.  
  1792. Class VBEnumModule : {VBObject} {
  1793.     constructor
  1794.     method destructor
  1795.     method generate
  1796.     method unique
  1797.     method constSet
  1798.     method addConst
  1799.     method removeConst
  1800.     attribute comment
  1801.     attribute _constSet
  1802. }
  1803.  
  1804. constructor VBEnumModule {class this} {
  1805.     set this [VBObject::constructor $class $this]
  1806.     $this _constSet [List new]
  1807.     # Start constructor user section
  1808.     # End constructor user section
  1809.     return $this
  1810. }
  1811.  
  1812. method VBEnumModule::destructor {this} {
  1813.     # Start destructor user section
  1814.     # End destructor user section
  1815.     $this VBObject::destructor
  1816. }
  1817.  
  1818. method VBEnumModule::generate {this section} {
  1819.         if {[$this comment] != ""} {
  1820.               [$this comment] generate $section
  1821.         }
  1822.  
  1823.         $section append "Attribute VB_Name = \""
  1824.         $section append "[$this name]Extras"
  1825.         $section append "\"\n"
  1826.     $this addHeader bas $section
  1827.         $section append "Option Explicit\n\n"
  1828.         $section append "${VBCookie::userDefEnums}\n\n"
  1829.         $section append "Enum [$this name]\n"
  1830.         $section indent +
  1831.         [$this constSet] foreach const {
  1832.                 $const generate $section
  1833.         }  
  1834.         $section indent -
  1835.         $section append "End Enum\n"
  1836. }
  1837.  
  1838. method VBEnumModule::unique {this} {
  1839.        set value 0
  1840.        set found 0
  1841.  
  1842.        while {!$found} {
  1843.            incr value
  1844.            set found 1
  1845.            [$this constSet] foreach const {
  1846.                    if {[$const hasValue]} {
  1847.                         if {[$const value] == $value} {
  1848.                              set found 0
  1849.                              break
  1850.                         }
  1851.                    } 
  1852.            }
  1853.        }
  1854.        return $value
  1855. }
  1856.  
  1857. # Do not delete this line -- regeneration end marker
  1858.  
  1859. method VBEnumModule::constSet {this} {
  1860.     return [$this _constSet]
  1861. }
  1862.  
  1863. method VBEnumModule::addConst {this newConst} {
  1864.     [$this _constSet] append $newConst
  1865.     $newConst _module $this
  1866. }
  1867.  
  1868. method VBEnumModule::removeConst {this oldConst} {
  1869.     $oldConst _module ""
  1870.     [$this _constSet] removeValue $oldConst
  1871. }
  1872.  
  1873. #---------------------------------------------------------------------------
  1874. #      File:           @(#)vbletprope.tcl    /main/titanic/1
  1875. #---------------------------------------------------------------------------
  1876.  
  1877. # Start user added include file section
  1878. # End user added include file section
  1879.  
  1880.  
  1881. Class VBLetProperty : {VBProperty} {
  1882.     constructor
  1883.     method destructor
  1884.     attribute procType
  1885. }
  1886.  
  1887. constructor VBLetProperty {class this} {
  1888.     set this [VBProperty::constructor $class $this]
  1889.     $this procType "Property Let"
  1890.     # Start constructor user section
  1891.     # End constructor user section
  1892.     return $this
  1893. }
  1894.  
  1895. method VBLetProperty::destructor {this} {
  1896.     # Start destructor user section
  1897.     # End destructor user section
  1898.     $this VBProperty::destructor
  1899. }
  1900.  
  1901. # Do not delete this line -- regeneration end marker
  1902.  
  1903. #---------------------------------------------------------------------------
  1904. #      File:           @(#)vbmenu.tcl    /main/titanic/1
  1905. #---------------------------------------------------------------------------
  1906.  
  1907. # Start user added include file section
  1908. # End user added include file section
  1909.  
  1910.  
  1911. Class VBMenu : {VBContainer} {
  1912.     constructor
  1913.     method destructor
  1914.     method getContainers
  1915.     method addContain
  1916.     method generateMiddle
  1917.     method addSubmenu
  1918.     method removeSubmenu
  1919.     method addSortedsubmenu
  1920.     method removeSortedsubmenu
  1921.     attribute guiType
  1922.     attribute submenuSet
  1923.     attribute sortedsubmenuSet
  1924. }
  1925.  
  1926. constructor VBMenu {class this} {
  1927.     set this [VBContainer::constructor $class $this]
  1928.     $this guiType "Menu"
  1929.     $this submenuSet [List new]
  1930.     $this sortedsubmenuSet [List new]
  1931.     # Start constructor user section
  1932.     # End constructor user section
  1933.     return $this
  1934. }
  1935.  
  1936. method VBMenu::destructor {this} {
  1937.     # Start destructor user section
  1938.     # End destructor user section
  1939.     $this VBContainer::destructor
  1940. }
  1941.  
  1942. method VBMenu::getContainers {this frm} {
  1943.         $frm addContainer $this
  1944.         [$this sortedsubmenuSet] foreach sortedsubmenu {
  1945.                $sortedsubmenu getContainers $frm
  1946.         }
  1947.         [$this submenuSet] foreach submenu {
  1948.                $submenu getContainers $frm
  1949.         }
  1950. }
  1951.  
  1952. method VBMenu::addContain {this cl} {
  1953.         $this addSubmenu $cl
  1954. }
  1955.  
  1956. method VBMenu::generateMiddle {this section} {
  1957.         [$this sortedsubmenuSet] foreach sortedsubmenu {
  1958.                $sortedsubmenu generate $section
  1959.         }
  1960.         [$this submenuSet] foreach submenu {
  1961.                $submenu generate $section
  1962.         }
  1963. }
  1964.  
  1965. # Do not delete this line -- regeneration end marker
  1966.  
  1967. method VBMenu::addSubmenu {this newSubmenu} {
  1968.     [$this submenuSet] append $newSubmenu
  1969.  
  1970. }
  1971.  
  1972. method VBMenu::removeSubmenu {this oldSubmenu} {
  1973.     [$this submenuSet] removeValue $oldSubmenu
  1974. }
  1975.  
  1976. method VBMenu::addSortedsubmenu {this newSortedsubmenu} {
  1977.     [$this sortedsubmenuSet] append $newSortedsubmenu
  1978.  
  1979. }
  1980.  
  1981. method VBMenu::removeSortedsubmenu {this oldSortedsubmenu} {
  1982.     [$this sortedsubmenuSet] removeValue $oldSortedsubmenu
  1983. }
  1984.  
  1985.