home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / pbtarget.tcl < prev    next >
Text File  |  1997-05-16  |  60KB  |  2,249 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            : pbtarget.tcl
  17. #       Author          : 
  18. #       Original date   : May 1997
  19. #       Description     : Classes for code generation
  20. #
  21. #---------------------------------------------------------------------------
  22.  
  23. #---------------------------------------------------------------------------
  24. #      File:           @(#)pbaccess.tcl    /main/hindenburg/1
  25. #---------------------------------------------------------------------------
  26.  
  27. # Start user added include file section
  28. # End user added include file section
  29.  
  30.  
  31. Class PBAccess : {GCObject} {
  32.     constructor
  33.     method destructor
  34.     method generate
  35.     attribute accessRight
  36. }
  37.  
  38. constructor PBAccess {class this i_accessRight} {
  39.     set this [GCObject::constructor $class $this]
  40.     $this accessRight $i_accessRight
  41.     # Start constructor user section
  42.     # End constructor user section
  43.     return $this
  44. }
  45.  
  46. method PBAccess::destructor {this} {
  47.     # Start destructor user section
  48.     # End destructor user section
  49. }
  50.  
  51. method PBAccess::generate {this} {
  52.     return [$this accessRight]
  53. }
  54.  
  55. # Do not delete this line -- regeneration end marker
  56.  
  57. #---------------------------------------------------------------------------
  58. #      File:           @(#)pbbuiltinp.tcl    /main/hindenburg/3
  59. #---------------------------------------------------------------------------
  60.  
  61. # Start user added include file section
  62. # End user added include file section
  63.  
  64.  
  65. Class PBBuiltinProperty : {GCObject} {
  66.     constructor
  67.     method destructor
  68.     method generate
  69.     method clone
  70.     attribute name
  71.     attribute type
  72.     attribute value
  73.     attribute where
  74. }
  75.  
  76. global PBBuiltinProperty::InTypeDef
  77. set PBBuiltinProperty::InTypeDef 0
  78.  
  79. global PBBuiltinProperty::InOnCreate
  80. set PBBuiltinProperty::InOnCreate 1
  81.  
  82.  
  83. constructor PBBuiltinProperty {class this i_name i_type i_value} {
  84.     set this [GCObject::constructor $class $this]
  85.     $this name $i_name
  86.     $this type $i_type
  87.     $this value $i_value
  88.     # Start constructor user section
  89.  
  90.     # initialize 'where'
  91.     $this where ${PBBuiltinProperty::InTypeDef}
  92.  
  93.     # End constructor user section
  94.     return $this
  95. }
  96.  
  97. method PBBuiltinProperty::destructor {this} {
  98.     # Start destructor user section
  99.     # End destructor user section
  100. }
  101.  
  102. method PBBuiltinProperty::generate {this} {
  103.     if {[$this where] == ${PBBuiltinProperty::InTypeDef}} {
  104.         return "[$this type] [$this name] = [$this value]"
  105.     }
  106.     if {[$this where] == ${PBBuiltinProperty::InOnCreate}} {
  107.         return "this.[$this name] = [$this value]"
  108.     }
  109.     return ""
  110. }
  111.  
  112. method PBBuiltinProperty::clone {this} {
  113.     return [PBBuiltinProperty new [$this name] [$this type] [$this value] \
  114.         -where [$this where]]
  115. }
  116.  
  117. # Do not delete this line -- regeneration end marker
  118.  
  119. #---------------------------------------------------------------------------
  120. #      File:           @(#)pbclasskin.tcl    /main/hindenburg/1
  121. #---------------------------------------------------------------------------
  122.  
  123. # Start user added include file section
  124. # End user added include file section
  125.  
  126.  
  127. Class PBClassKind : {GCObject} {
  128.     constructor
  129.     method destructor
  130. }
  131.  
  132. global PBClassKind::Window
  133. set PBClassKind::Window "Window"
  134.  
  135. global PBClassKind::Menu
  136. set PBClassKind::Menu "Menu"
  137.  
  138. global PBClassKind::Structure
  139. set PBClassKind::Structure "Structure"
  140.  
  141. global PBClassKind::VCUserObject
  142. set PBClassKind::VCUserObject "VisualCustomUserObject"
  143.  
  144. global PBClassKind::VSUserObject
  145. set PBClassKind::VSUserObject "VisualStandardUserObject"
  146.  
  147. global PBClassKind::CCUserObject
  148. set PBClassKind::CCUserObject "ClassCustomUserObject"
  149.  
  150. global PBClassKind::CSUserObject
  151. set PBClassKind::CSUserObject "ClassStandardUserObject"
  152.  
  153. global PBClassKind::NotSupported
  154. set PBClassKind::NotSupported "NotSupported"
  155.  
  156.  
  157. constructor PBClassKind {class this} {
  158.     set this [GCObject::constructor $class $this]
  159.     # Start constructor user section
  160.     # End constructor user section
  161.     return $this
  162. }
  163.  
  164. method PBClassKind::destructor {this} {
  165.     # Start destructor user section
  166.     # End destructor user section
  167. }
  168.  
  169. # Do not delete this line -- regeneration end marker
  170.  
  171. #---------------------------------------------------------------------------
  172. #      File:           @(#)pbcookie.tcl    /main/hindenburg/4
  173. #---------------------------------------------------------------------------
  174.  
  175. # Start user added include file section
  176. # End user added include file section
  177.  
  178.  
  179. Class PBCookie : {GCObject} {
  180.     constructor
  181.     method destructor
  182. }
  183.  
  184. global PBCookie::implementThisFunction
  185. set PBCookie::implementThisFunction "// Implement this function !!"
  186.  
  187. global PBCookie::implementThisEvent
  188. set PBCookie::implementThisEvent "// Implement this event !!"
  189.  
  190. global PBCookie::dataAttributeSection
  191. set PBCookie::dataAttributeSection "// User defined attributes"
  192.  
  193. global PBCookie::associationAttributeSection
  194. set PBCookie::associationAttributeSection "// Association attributes"
  195.  
  196. global PBCookie::nonModeledAttributeSection
  197. set PBCookie::nonModeledAttributeSection "// Non modeled user defined attributes"
  198.  
  199. global PBCookie::associationAccessorMethod
  200. set PBCookie::associationAccessorMethod "// Association accessor method"
  201.  
  202. global PBCookie::startUserSection
  203. set PBCookie::startUserSection "// Start user code section"
  204.  
  205. global PBCookie::endUserSection
  206. set PBCookie::endUserSection "// End user code section"
  207.  
  208. global PBCookie::startBinaryDataSection
  209. set PBCookie::startBinaryDataSection "Start of PowerBuilder Binary Data Section : Do NOT Edit"
  210.  
  211. global PBCookie::endBinaryDataSection
  212. set PBCookie::endBinaryDataSection "End of PowerBuilder Binary Data Section : No Source Expected After This Point"
  213.  
  214. global PBCookie::controlClassMapSection
  215. set PBCookie::controlClassMapSection "// Control to class mappings"
  216.  
  217.  
  218. constructor PBCookie {class this} {
  219.     set this [GCObject::constructor $class $this]
  220.     # Start constructor user section
  221.     # End constructor user section
  222.     return $this
  223. }
  224.  
  225. method PBCookie::destructor {this} {
  226.     # Start destructor user section
  227.     # End destructor user section
  228. }
  229.  
  230. # Do not delete this line -- regeneration end marker
  231.  
  232. #---------------------------------------------------------------------------
  233. #      File:           @(#)pbdefiniti.tcl    /main/hindenburg/3
  234. #---------------------------------------------------------------------------
  235.  
  236. # Start user added include file section
  237. # End user added include file section
  238.  
  239.  
  240. Class PBDefinition : {GCObject} {
  241.     constructor
  242.     method destructor
  243.     method getGlobalDefinition
  244.     method libraryEntry
  245.     attribute name
  246.     attribute isGlobalType
  247.     attribute isRegenerated
  248.     attribute _libraryEntry
  249.     attribute ooplClass
  250. }
  251.  
  252. constructor PBDefinition {class this i_name ooplClass} {
  253.     set this [GCObject::constructor $class $this]
  254.     $this isGlobalType 1
  255.     $this isRegenerated 0
  256.     $this name $i_name
  257.     $this ooplClass $ooplClass
  258.     # Start constructor user section
  259.     # End constructor user section
  260.     return $this
  261. }
  262.  
  263. method PBDefinition::destructor {this} {
  264.     # Start destructor user section
  265.     # End destructor user section
  266. }
  267.  
  268. method PBDefinition::getGlobalDefinition {this} {
  269.     return $this
  270. }
  271.  
  272. # Do not delete this line -- regeneration end marker
  273.  
  274. method PBDefinition::libraryEntry {this args} {
  275.     if {$args == ""} {
  276.         return [$this _libraryEntry]
  277.     }
  278.     set ref [$this _libraryEntry]
  279.     if {$ref != ""} {
  280.         $ref _globalDefinition ""
  281.     }
  282.     set obj [lindex $args 0]
  283.     if {$obj != ""} {
  284.         $obj _globalDefinition $this
  285.     }
  286.     $this _libraryEntry $obj
  287. }
  288.  
  289. #---------------------------------------------------------------------------
  290. #      File:           @(#)pbfeature.tcl    /main/hindenburg/1
  291. #---------------------------------------------------------------------------
  292.  
  293. # Start user added include file section
  294. # End user added include file section
  295.  
  296.  
  297. Class PBFeature : {GCObject} {
  298.     constructor
  299.     method destructor
  300.     attribute name
  301.     attribute type
  302. }
  303.  
  304. constructor PBFeature {class this i_name type} {
  305.     set this [GCObject::constructor $class $this]
  306.     $this name $i_name
  307.     $this type $type
  308.     # Start constructor user section
  309.     # End constructor user section
  310.     return $this
  311. }
  312.  
  313. method PBFeature::destructor {this} {
  314.     # Start destructor user section
  315.     # End destructor user section
  316. }
  317.  
  318. # Do not delete this line -- regeneration end marker
  319.  
  320. #---------------------------------------------------------------------------
  321. #      File:           @(#)pblibrarye.tcl    /main/hindenburg/2
  322. #---------------------------------------------------------------------------
  323.  
  324. # Start user added include file section
  325. # End user added include file section
  326.  
  327.  
  328. Class PBLibraryEntry : {GCObject} {
  329.     constructor
  330.     method destructor
  331.     method getName
  332.     method getKind
  333.     method getFileType
  334.     method getSrcFileType
  335.     method generate
  336.     method genExportHeader
  337.     method genExportComments
  338.     method model
  339.     method globalDefinition
  340.     attribute _model
  341.     attribute _globalDefinition
  342.     attribute exportComments
  343. }
  344.  
  345. constructor PBLibraryEntry {class this model globalDefinition} {
  346.     set this [GCObject::constructor $class $this]
  347.     $this _model $model
  348.     [$model _libraryEntrySet] append $this
  349.     $this _globalDefinition $globalDefinition
  350.     $globalDefinition _libraryEntry $this
  351.     # Start constructor user section
  352.     $this exportComments ""
  353.     # End constructor user section
  354.     return $this
  355. }
  356.  
  357. method PBLibraryEntry::destructor {this} {
  358.     # Start destructor user section
  359.     # End destructor user section
  360. }
  361.  
  362. method PBLibraryEntry::getName {this} {
  363.     return [[$this globalDefinition] name]
  364. }
  365.  
  366. method PBLibraryEntry::getKind {this} {
  367.     return [[$this globalDefinition] getKind]
  368. }
  369.  
  370. method PBLibraryEntry::getFileType {this} {
  371.     set kind [$this getKind]
  372.  
  373.     if {$kind == ${PBClassKind::Window}} {
  374.         return "window"
  375.     } elseif {$kind == ${PBClassKind::Menu}} {
  376.         return "menu"
  377.     } elseif {$kind == ${PBClassKind::Structure}} {
  378.         return "structure"
  379.     } elseif {$kind == ${PBClassKind::VCUserObject} ||
  380.             $kind == ${PBClassKind::VSUserObject} ||
  381.             $kind == ${PBClassKind::CCUserObject} ||
  382.             $kind == ${PBClassKind::CSUserObject}} {
  383.         return "userobject"
  384.     }
  385.     return ""
  386. }
  387.  
  388. method PBLibraryEntry::getSrcFileType {this} {
  389.     set fileType [$this getFileType]
  390.     if {$fileType == ""} {
  391.         return ""
  392.     }
  393.     return "sr[string index $fileType 0]"
  394. }
  395.  
  396. method PBLibraryEntry::generate {this} {
  397.     set sect [TextSection new]
  398.     $this genExportHeader $sect
  399.     $this genExportComments $sect
  400.     [$this globalDefinition] generate $sect
  401.     return $sect
  402. }
  403.  
  404. method PBLibraryEntry::genExportHeader {this sect} {
  405.     $sect append \
  406.         "\$PBExportHeader\$[$this getName].[$this getSrcFileType]\n"
  407. }
  408.  
  409. method PBLibraryEntry::genExportComments {this sect} {
  410.     if {[$this exportComments] != ""} {
  411.         set comment [$this exportComments]
  412.     } else {
  413.         set comment "Generated by ObjectTeam"
  414.     }
  415.     $sect append "\$PBExportComments\$$comment\n"
  416. }
  417.  
  418. # Do not delete this line -- regeneration end marker
  419.  
  420. method PBLibraryEntry::model {this args} {
  421.     if {$args == ""} {
  422.         return [$this _model]
  423.     }
  424.     set ref [$this _model]
  425.     if {$ref != ""} {
  426.         [$ref _libraryEntrySet] removeValue $this
  427.     }
  428.     set obj [lindex $args 0]
  429.     if {$obj != ""} {
  430.         [$obj _libraryEntrySet] append $this
  431.     }
  432.     $this _model $obj
  433. }
  434.  
  435. method PBLibraryEntry::globalDefinition {this args} {
  436.     if {$args == ""} {
  437.         return [$this _globalDefinition]
  438.     }
  439.     set ref [$this _globalDefinition]
  440.     if {$ref != ""} {
  441.         $ref _libraryEntry ""
  442.     }
  443.     set obj [lindex $args 0]
  444.     if {$obj != ""} {
  445.         $obj _libraryEntry $this
  446.     }
  447.     $this _globalDefinition $obj
  448. }
  449.  
  450. #---------------------------------------------------------------------------
  451. #      File:           @(#)pbmodel.tcl    /main/hindenburg/1
  452. #---------------------------------------------------------------------------
  453.  
  454. # Start user added include file section
  455. # End user added include file section
  456.  
  457.  
  458. Class PBModel : {GCObject} {
  459.     constructor
  460.     method destructor
  461.     method generate
  462.     method findLibraryEntry
  463.     method libraryEntrySet
  464.     method addLibraryEntry
  465.     method removeLibraryEntry
  466.     attribute _libraryEntrySet
  467. }
  468.  
  469. constructor PBModel {class this} {
  470.     set this [GCObject::constructor $class $this]
  471.     $this _libraryEntrySet [List new]
  472.     # Start constructor user section
  473.     # End constructor user section
  474.     return $this
  475. }
  476.  
  477. method PBModel::destructor {this} {
  478.     # Start destructor user section
  479.     # End destructor user section
  480. }
  481.  
  482. method PBModel::generate {this TypeToClassDict} {
  483.     [$this libraryEntrySet] foreach entry {
  484.         set sectionDict [Dictionary new]
  485.         $sectionDict set [$entry getFileType] [$entry generate]
  486.         set ooplClass [[$entry globalDefinition] ooplClass]
  487.         $TypeToClassDict set $ooplClass $sectionDict
  488.     }
  489. }
  490.  
  491. method PBModel::findLibraryEntry {this name kind} {
  492.     [$this libraryEntrySet] foreach entry {
  493.         if {[$entry getName] == $name && [$entry getKind] == $kind} {
  494.             return $entry
  495.         }
  496.     }
  497.  
  498.     return ""
  499. }
  500.  
  501. # Do not delete this line -- regeneration end marker
  502.  
  503. method PBModel::libraryEntrySet {this} {
  504.     return [$this _libraryEntrySet]
  505. }
  506.  
  507. method PBModel::addLibraryEntry {this newLibraryEntry} {
  508.     [$this _libraryEntrySet] append $newLibraryEntry
  509.     $newLibraryEntry _model $this
  510. }
  511.  
  512. method PBModel::removeLibraryEntry {this oldLibraryEntry} {
  513.     $oldLibraryEntry _model ""
  514.     [$this _libraryEntrySet] removeValue $oldLibraryEntry
  515. }
  516.  
  517. #---------------------------------------------------------------------------
  518. #      File:           @(#)pbmodifier.tcl    /main/hindenburg/1
  519. #---------------------------------------------------------------------------
  520.  
  521. # Start user added include file section
  522. # End user added include file section
  523.  
  524.  
  525. Class PBModifier : {GCObject} {
  526.     constructor
  527.     method destructor
  528.     method generate
  529.     attribute name
  530. }
  531.  
  532. constructor PBModifier {class this i_name} {
  533.     set this [GCObject::constructor $class $this]
  534.     $this name $i_name
  535.     # Start constructor user section
  536.     # End constructor user section
  537.     return $this
  538. }
  539.  
  540. method PBModifier::destructor {this} {
  541.     # Start destructor user section
  542.     # End destructor user section
  543. }
  544.  
  545. method PBModifier::generate {this} {
  546.     return [$this name]
  547. }
  548.  
  549. # Do not delete this line -- regeneration end marker
  550.  
  551. #---------------------------------------------------------------------------
  552. #      File:           @(#)pbtype.tcl    /main/hindenburg/1
  553. #---------------------------------------------------------------------------
  554.  
  555. # Start user added include file section
  556. # End user added include file section
  557.  
  558.  
  559. Class PBType : {GCObject} {
  560.     constructor
  561.     method destructor
  562.     method generate
  563.     attribute name
  564. }
  565.  
  566. constructor PBType {class this i_name} {
  567.     set this [GCObject::constructor $class $this]
  568.     $this name $i_name
  569.     # Start constructor user section
  570.     # End constructor user section
  571.     return $this
  572. }
  573.  
  574. method PBType::destructor {this} {
  575.     # Start destructor user section
  576.     # End destructor user section
  577. }
  578.  
  579. method PBType::generate {this} {
  580.     return [$this name]
  581. }
  582.  
  583. # Do not delete this line -- regeneration end marker
  584.  
  585. #---------------------------------------------------------------------------
  586. #      File:           @(#)pbclass.tcl    /main/hindenburg/16
  587. #---------------------------------------------------------------------------
  588.  
  589. # Start user added include file section
  590. # End user added include file section
  591.  
  592.  
  593. Class PBClass : {PBDefinition} {
  594.     constructor
  595.     method destructor
  596.     method generate
  597.     method generateForward
  598.     method generateTypeDef
  599.     method generateInstanceVars
  600.     method genOnCreateBody
  601.     method genOnDestroyBody
  602.     method genTypeSignature
  603.     method findObjectStructure
  604.     method findObjectFunctions
  605.     method findObjectFunction
  606.     method findUserEvent
  607.     method findScript
  608.     method findEvent
  609.     method matchObjectFunction
  610.     method matchEvent
  611.     method objectStructureSet
  612.     method addObjectStructure
  613.     method removeObjectStructure
  614.     method addInstanceVar
  615.     method removeInstanceVar
  616.     method addAssocInstanceVar
  617.     method removeAssocInstanceVar
  618.     method addSharedVar
  619.     method removeSharedVar
  620.     method addObjectFunction
  621.     method removeObjectFunction
  622.     method addUserEvent
  623.     method removeUserEvent
  624.     method addScript
  625.     method removeScript
  626.     attribute superClassName
  627.     attribute builtinSuperClassName
  628.     attribute nonModeledSharedVars
  629.     attribute _objectStructureSet
  630.     attribute instanceVarSet
  631.     attribute assocInstanceVarSet
  632.     attribute sharedVarSet
  633.     attribute objectFunctionSet
  634.     attribute userEventSet
  635.     attribute scriptSet
  636.     attribute onDestroyBody
  637.     attribute onCreateBody
  638.     attribute localExternalFuncs
  639.     attribute nonModeledInstanceVars
  640. }
  641.  
  642. constructor PBClass {class this i_name ooplClass i_superClassName i_builtinSuperClassName} {
  643.     set this [PBDefinition::constructor $class $this $i_name $ooplClass]
  644.     $this superClassName $i_superClassName
  645.     $this builtinSuperClassName $i_builtinSuperClassName
  646.     $this _objectStructureSet [List new]
  647.     $this instanceVarSet [List new]
  648.     $this assocInstanceVarSet [List new]
  649.     $this sharedVarSet [List new]
  650.     $this objectFunctionSet [List new]
  651.     $this userEventSet [List new]
  652.     $this scriptSet [List new]
  653.     # Start constructor user section
  654.     # End constructor user section
  655.     return $this
  656. }
  657.  
  658. method PBClass::destructor {this} {
  659.     # Start destructor user section
  660.     # End destructor user section
  661.     $this PBDefinition::destructor
  662. }
  663.  
  664. method PBClass::generate {this sect} {
  665.     if [$this isGlobalType] {
  666.         # Generate forward
  667.         #
  668.         $sect append "forward\n"
  669.         $this generateForward $sect
  670.         $sect append "end forward\n\n"
  671.  
  672.         # Generate object structures
  673.         #
  674.         [$this objectStructureSet] foreach struct {
  675.             $struct generate $sect
  676.             $sect append "\n"
  677.         }
  678.  
  679.         # Generate shared variables
  680.         #
  681.         $sect append "shared variables\n"
  682.         $sect append "${PBCookie::dataAttributeSection}\n"
  683.         [$this sharedVarSet] foreach var {
  684.             $var generate $sect
  685.             $sect append "\n"
  686.         }
  687.         $sect append "\n${PBCookie::nonModeledAttributeSection}\n"
  688.         if {[$this nonModeledSharedVars] != ""} {
  689.             $sect appendSect [$this nonModeledSharedVars]
  690.         }
  691.         $sect append "\n"
  692.         $sect append "end variables\n\n"
  693.     }
  694.  
  695.     # Generate type definition
  696.     #
  697.     $sect append "[$this genTypeSignature]\n"
  698.     $this generateTypeDef $sect
  699.     $sect append "end type\n"
  700.  
  701.     if [$this isGlobalType] {
  702.         # Generate global reference variable declaration
  703.         #
  704.         $sect append "global [$this name] [$this name]\n\n"
  705.  
  706.         # Generate type prototypes (i.e. local external functions)
  707.         #
  708.         if {[$this localExternalFuncs] != ""} {
  709.             $sect append "type prototypes\n"
  710.             $sect appendSect [$this localExternalFuncs]
  711.             $sect append "end prototypes\n\n"
  712.         }
  713.  
  714.         # Generate instance variables
  715.         #
  716.         $sect append "type variables\n"
  717.         $this generateInstanceVars $sect
  718.         $sect append "end variables\n\n"
  719.  
  720.         # Generate function prototypes
  721.         #
  722.         set defSect [TextSection new]
  723.         if ![[$this objectFunctionSet] empty] {
  724.             $sect append "forward prototypes\n"
  725.             [$this objectFunctionSet] foreach func {
  726.                 $func generate $sect $defSect
  727.                 $defSect append "\n"
  728.             }
  729.             $sect append "end prototypes\n\n"
  730.         }
  731.     } else {
  732.         $sect append "\n"
  733.     }
  734.  
  735.     # Generate user event bodies
  736.     #
  737.     [$this userEventSet] foreach event {
  738.         $event generate $sect "eventDefinition"
  739.         $sect append "\n"
  740.     }
  741.  
  742.     if [$this isGlobalType] {
  743.         # Generate function bodies
  744.         #
  745.         if {[$defSect contents] != ""} {
  746.             $sect appendSect $defSect
  747.         }
  748.     }
  749.     
  750.     # Generate on create & on destroy
  751.     #
  752.     $this genOnCreateBody
  753.     set bodySect [$this onCreateBody]
  754.     if {$bodySect != "" && [$bodySect contents] != ""} {
  755.         $sect append "on [$this name].create\n"
  756.         $sect appendSect $bodySect
  757.         $sect append "end on\n\n"
  758.     }
  759.     $this genOnDestroyBody
  760.     set bodySect [$this onDestroyBody]
  761.     if {$bodySect != "" && [$bodySect contents] != ""} {
  762.         $sect append "on [$this name].destroy\n"
  763.         $sect appendSect $bodySect
  764.         $sect append "end on\n\n"
  765.     }
  766.  
  767.     # Generate script bodies
  768.     #
  769.     [$this scriptSet] foreach script {
  770.         $script generate $sect "eventDefinition"
  771.         $sect append "\n"
  772.     }
  773. }
  774.  
  775. method PBClass::generateForward {this sect} {
  776.     $sect append "[$this genTypeSignature]\n"
  777.     $sect append "end type\n"
  778. }
  779.  
  780. method PBClass::generateTypeDef {this sect} {
  781.     # Generate event declarations
  782.     #
  783.     [$this userEventSet] foreach event {
  784.         $event generate $sect "eventDeclaration"
  785.         $sect append "\n"
  786.     }
  787. }
  788.  
  789. method PBClass::generateInstanceVars {this sect} {
  790.     $sect append "${PBCookie::dataAttributeSection}\n"
  791.     [$this instanceVarSet] foreach var {
  792.         $var generate $sect
  793.         $sect append "\n"
  794.     }
  795.     $sect append "\n${PBCookie::associationAttributeSection}\n"
  796.     [$this assocInstanceVarSet] foreach var {
  797.         $var generate $sect
  798.         $sect append "\n"
  799.     }
  800.     $sect append "\n${PBCookie::nonModeledAttributeSection}\n"
  801.     if {[$this nonModeledInstanceVars] != ""} {
  802.         $sect appendSect [$this nonModeledInstanceVars]
  803.     }
  804.     $sect append "\n"
  805. }
  806.  
  807. method PBClass::genOnCreateBody {this} {
  808.     # Default no 'on create' part
  809.     #
  810. }
  811.  
  812. method PBClass::genOnDestroyBody {this} {
  813.     # Default no 'on destroy' part
  814.     #
  815. }
  816.  
  817. method PBClass::genTypeSignature {this} {
  818.     set signature ""
  819.     if [$this isGlobalType] {
  820.         set signature "global "
  821.     }
  822.     set signature \
  823.         "${signature}type [$this name] from [$this superClassName]"
  824.     return $signature
  825. }
  826.  
  827. method PBClass::findObjectStructure {this name} {
  828.     set name [string tolower $name]
  829.     [$this objectStructureSet] foreach struct {
  830.         if {[string tolower [$struct name]] == $name} {
  831.             return $struct
  832.         }
  833.     }
  834.  
  835.     return ""
  836. }
  837.  
  838. method PBClass::findObjectFunctions {this name} {
  839.     set list [List new]
  840.     set name [string tolower $name]
  841.  
  842.     [$this objectFunctionSet] foreach func {
  843.         if {[string tolower [$func name]] == $name} {
  844.             $list append $func
  845.         }
  846.     }
  847.  
  848.     return $list
  849. }
  850.  
  851. method PBClass::findObjectFunction {this name argTypes} {
  852.     set name [string tolower $name]
  853.  
  854.     [$this objectFunctionSet] foreach func {
  855.         if {[string tolower [$func name]] != $name} {
  856.             continue
  857.         }
  858.         set paramTypes [list]
  859.         [$func parameterSet] foreach param {
  860.             lappend paramTypes [string tolower [[$param type] name]]
  861.         }
  862.         if {$paramTypes == [string tolower [$argTypes contents]]} {
  863.             return $func
  864.         }
  865.     }
  866.  
  867.     return ""
  868. }
  869.  
  870. method PBClass::findUserEvent {this name} {
  871.     set name [string tolower $name]
  872.  
  873.     [$this userEventSet] foreach event {
  874.         if {[string tolower [$event name]] == $name} {
  875.             return $event
  876.         }
  877.     }
  878.  
  879.     return ""
  880. }
  881.  
  882. method PBClass::findScript {this name} {
  883.     set name [string tolower $name]
  884.  
  885.     [$this scriptSet] foreach script {
  886.         if {[string tolower [$script name]] == $name} {
  887.             return $script
  888.         }
  889.     }
  890.  
  891.     return ""
  892. }
  893.  
  894. method PBClass::findEvent {this name} {
  895.     set event [$this findScript $name]
  896.     if {$event == "" } {
  897.         set event [$this findUserEvent $name]
  898.     }
  899.     return $event
  900. }
  901.  
  902. method PBClass::matchObjectFunction {this name} {
  903.     # finds a function with the same name with an empty body
  904.     # because of overloadeing the argument type (and number) 
  905.     # does not have to match
  906.     set name [string tolower $name]
  907.  
  908.     [$this objectFunctionSet] foreach func {
  909.         if {[string tolower [$func name]] == $name} {
  910.             if {[$func body] == ""} {
  911.                 return $func
  912.             }
  913.         }
  914.     }
  915.     return ""    
  916. }
  917.  
  918. method PBClass::matchEvent {this name} {
  919.     # finds a event with the same name with an empty body
  920.     # because there is no overloading there's no need for
  921.     # finding a following match like at functions.
  922.     set name [string tolower $name]
  923.     
  924.     set event [$this findEvent $name]
  925.     if {$event != ""} {
  926.         if {[$event body] == ""} {
  927.             return $event
  928.         }
  929.     }
  930.     return ""
  931. }
  932.  
  933. # Do not delete this line -- regeneration end marker
  934.  
  935. method PBClass::objectStructureSet {this} {
  936.     return [$this _objectStructureSet]
  937. }
  938.  
  939. method PBClass::addObjectStructure {this newObjectStructure} {
  940.     [$this _objectStructureSet] append $newObjectStructure
  941.     $newObjectStructure _theClass $this
  942. }
  943.  
  944. method PBClass::removeObjectStructure {this oldObjectStructure} {
  945.     $oldObjectStructure _theClass ""
  946.     [$this _objectStructureSet] removeValue $oldObjectStructure
  947. }
  948.  
  949. method PBClass::addInstanceVar {this newInstanceVar} {
  950.     [$this instanceVarSet] append $newInstanceVar
  951.  
  952. }
  953.  
  954. method PBClass::removeInstanceVar {this oldInstanceVar} {
  955.     [$this instanceVarSet] removeValue $oldInstanceVar
  956. }
  957.  
  958. method PBClass::addAssocInstanceVar {this newAssocInstanceVar} {
  959.     [$this assocInstanceVarSet] append $newAssocInstanceVar
  960.  
  961. }
  962.  
  963. method PBClass::removeAssocInstanceVar {this oldAssocInstanceVar} {
  964.     [$this assocInstanceVarSet] removeValue $oldAssocInstanceVar
  965. }
  966.  
  967. method PBClass::addSharedVar {this newSharedVar} {
  968.     [$this sharedVarSet] append $newSharedVar
  969.  
  970. }
  971.  
  972. method PBClass::removeSharedVar {this oldSharedVar} {
  973.     [$this sharedVarSet] removeValue $oldSharedVar
  974. }
  975.  
  976. method PBClass::addObjectFunction {this newObjectFunction} {
  977.     [$this objectFunctionSet] append $newObjectFunction
  978.  
  979. }
  980.  
  981. method PBClass::removeObjectFunction {this oldObjectFunction} {
  982.     [$this objectFunctionSet] removeValue $oldObjectFunction
  983. }
  984.  
  985. method PBClass::addUserEvent {this newUserEvent} {
  986.     [$this userEventSet] append $newUserEvent
  987.  
  988. }
  989.  
  990. method PBClass::removeUserEvent {this oldUserEvent} {
  991.     [$this userEventSet] removeValue $oldUserEvent
  992. }
  993.  
  994. method PBClass::addScript {this newScript} {
  995.     [$this scriptSet] append $newScript
  996.  
  997. }
  998.  
  999. method PBClass::removeScript {this oldScript} {
  1000.     [$this scriptSet] removeValue $oldScript
  1001. }
  1002.  
  1003. #---------------------------------------------------------------------------
  1004. #      File:           @(#)pbvisual.tcl    /main/hindenburg/7
  1005. #---------------------------------------------------------------------------
  1006.  
  1007. # Start user added include file section
  1008. # End user added include file section
  1009.  
  1010.  
  1011. Class PBVisual : {PBClass} {
  1012.     constructor
  1013.     method destructor
  1014.     method generate
  1015.     method genTypeSignature
  1016.     method generateTypeDef
  1017.     method generateControlClassMapping
  1018.     method genOnCreateBody
  1019.     method genOnDestroyBody
  1020.     method generateBuiltinProperties
  1021.     method getGlobalDefinition
  1022.     method container
  1023.     method getBuiltinProperty
  1024.     method setBuiltinProperty
  1025.     method removeBuiltinProperty
  1026.     attribute _container
  1027.     attribute onDestroyResidue
  1028.     attribute onCreateResidue
  1029.     attribute builtinProperty
  1030. }
  1031.  
  1032. constructor PBVisual {class this i_name ooplClass i_superClassName i_builtinSuperClassName} {
  1033.     set this [PBClass::constructor $class $this $i_name $ooplClass $i_superClassName $i_builtinSuperClassName]
  1034.     $this builtinProperty [Dictionary new]
  1035.     # Start constructor user section
  1036.     # End constructor user section
  1037.     return $this
  1038. }
  1039.  
  1040. method PBVisual::destructor {this} {
  1041.     # Start destructor user section
  1042.     # End destructor user section
  1043.     $this PBClass::destructor
  1044. }
  1045.  
  1046. method PBVisual::generate {this sect} {
  1047.     # If this a newly generated object, provide some default property
  1048.     # settings.
  1049.     #
  1050.     if ![$this isRegenerated] {
  1051.         set classInfo [[PBBuiltinInfo::global] \
  1052.             getBuiltinClass [$this builtinSuperClassName]]
  1053.         if {$classInfo != ""} {
  1054.             [$classInfo mandatoryProp] foreach propName prop {
  1055.                 $this setBuiltinProperty $propName [$prop clone]
  1056.             }
  1057.             set residue [$classInfo initialOnCreateResidue]
  1058.             if {$residue != ""} {
  1059.                 # no need to clone the TextSection here
  1060.                 $this onCreateResidue $residue
  1061.             }
  1062.             set residue [$classInfo initialOnDestroyResidue]
  1063.             if {$residue != ""} {
  1064.                 # no need to clone the TextSection here
  1065.                 $this onDestroyResidue $residue
  1066.             }
  1067.         }
  1068.         }
  1069.  
  1070.     $this PBClass::generate $sect
  1071. }
  1072.  
  1073. method PBVisual::genTypeSignature {this} {
  1074.     set signature [$this PBClass::genTypeSignature]
  1075.     if {[$this container] != ""} {
  1076.         set signature "${signature} within [[$this container] name]"
  1077.     }
  1078.     return $signature
  1079. }
  1080.  
  1081. method PBVisual::generateTypeDef {this sect} {
  1082.     # Generate builtin property settings
  1083.     #
  1084.     $this generateBuiltinProperties $sect ${PBBuiltinProperty::InTypeDef}
  1085.  
  1086.     $this PBClass::generateTypeDef $sect
  1087. }
  1088.  
  1089. method PBVisual::generateControlClassMapping {this sect} {
  1090.     set ooplClass [$this ooplClass]
  1091.     if {[$this ooplClass] != ""} {
  1092.         $sect append "//    [$this name] --> [$ooplClass getName]\n"
  1093.     }
  1094. }
  1095.  
  1096. method PBVisual::genOnCreateBody {this} {
  1097.     if {[$this onCreateBody] == ""} {
  1098.         $this onCreateBody [TextSection new]
  1099.     }
  1100.     set sect [$this onCreateBody]
  1101.  
  1102.     # Gen builtin property settings
  1103.     #
  1104.     $this generateBuiltinProperties $sect ${PBBuiltinProperty::InOnCreate}
  1105.     
  1106.     $this PBClass::genOnCreateBody
  1107.  
  1108.     if {[$this onCreateResidue] != ""} {
  1109.         $sect appendSect [$this onCreateResidue]
  1110.     }
  1111. }
  1112.  
  1113. method PBVisual::genOnDestroyBody {this} {
  1114.     if {[$this onDestroyBody] == ""} {
  1115.         $this onDestroyBody [TextSection new]
  1116.     }
  1117.     set sect [$this onDestroyBody]
  1118.  
  1119.     $this PBClass::genOnDestroyBody
  1120.  
  1121.     if {[$this onDestroyResidue] != ""} {
  1122.         $sect appendSect [$this onDestroyResidue]
  1123.     }
  1124. }
  1125.  
  1126. method PBVisual::generateBuiltinProperties {this sect where} {
  1127.     [$this builtinProperty] foreach propName prop {
  1128.         if {[$prop where] == $where} {
  1129.             $sect append "[$prop generate]\n"
  1130.         }
  1131.     }
  1132. }
  1133.  
  1134. method PBVisual::getGlobalDefinition {this} {
  1135.     set container [$this container]
  1136.     if {$container != ""} {
  1137.         return [$container getGlobalDefinition]
  1138.     }
  1139.     return $this
  1140. }
  1141.  
  1142. # Do not delete this line -- regeneration end marker
  1143.  
  1144. method PBVisual::container {this args} {
  1145.     if {$args == ""} {
  1146.         return [$this _container]
  1147.     }
  1148.     set ref [$this _container]
  1149.     if {$ref != ""} {
  1150.         [$ref _containedClassSet] removeValue $this
  1151.     }
  1152.     set obj [lindex $args 0]
  1153.     if {$obj != ""} {
  1154.         [$obj _containedClassSet] append $this
  1155.     }
  1156.     $this _container $obj
  1157. }
  1158.  
  1159. method PBVisual::getBuiltinProperty {this name} {
  1160.     return [[$this builtinProperty] set $name]
  1161. }
  1162.  
  1163. method PBVisual::setBuiltinProperty {this name newBuiltinProperty} {
  1164.     [$this builtinProperty] set $name $newBuiltinProperty
  1165. }
  1166.  
  1167. method PBVisual::removeBuiltinProperty {this name} {
  1168.     [$this builtinProperty] unset $name
  1169. }
  1170.  
  1171. #---------------------------------------------------------------------------
  1172. #      File:           @(#)pbvisualco.tcl    /main/hindenburg/8
  1173. #---------------------------------------------------------------------------
  1174.  
  1175. # Start user added include file section
  1176. # End user added include file section
  1177.  
  1178.  
  1179. Class PBVisualContainer : {PBVisual} {
  1180.     constructor
  1181.     method destructor
  1182.     method generate
  1183.     method generateTypeDef
  1184.     method generateForward
  1185.     method generateInstanceVars
  1186.     method generateControlClassMapping
  1187.     method genOnCreateBody
  1188.     method genOnDestroyBody
  1189.     method findContainedClass
  1190.     method containedClassSet
  1191.     method addContainedClass
  1192.     method removeContainedClass
  1193.     attribute containerArray
  1194.     attribute binaryData
  1195.     attribute _containedClassSet
  1196. }
  1197.  
  1198. constructor PBVisualContainer {class this i_name ooplClass i_superClassName i_builtinSuperClassName} {
  1199.     set this [PBVisual::constructor $class $this $i_name $ooplClass $i_superClassName $i_builtinSuperClassName]
  1200.     $this containerArray "Control"
  1201.     $this _containedClassSet [List new]
  1202.     # Start constructor user section
  1203.     # End constructor user section
  1204.     return $this
  1205. }
  1206.  
  1207. method PBVisualContainer::destructor {this} {
  1208.     # Start destructor user section
  1209.     # End destructor user section
  1210.     $this PBVisual::destructor
  1211. }
  1212.  
  1213. method PBVisualContainer::generate {this sect} {
  1214.     $this PBVisual::generate $sect
  1215.  
  1216.     [$this containedClassSet] foreach class {
  1217.         $class generate $sect
  1218.     }
  1219.  
  1220.     if {[$this binaryData] != ""} {
  1221.         $sect append "\n${PBCookie::startBinaryDataSection}\n"
  1222.         $sect appendSect [$this binaryData]
  1223.         $sect append ${PBCookie::endBinaryDataSection}
  1224.     }
  1225. }
  1226.  
  1227. method PBVisualContainer::generateTypeDef {this sect} {
  1228.     $this PBVisual::generateTypeDef $sect
  1229.  
  1230.     # Generate contained object variables
  1231.     #
  1232.     [$this containedClassSet] foreach class {
  1233.         $sect append "[$class name] [$class name]\n"
  1234.     }
  1235. }
  1236.  
  1237. method PBVisualContainer::generateForward {this sect} {
  1238.     $this PBVisual::generateForward $sect
  1239.  
  1240.     set containedClassList [$this containedClassSet]
  1241.     if [$containedClassList empty] {
  1242.         return
  1243.     }
  1244.     $containedClassList foreach class {
  1245.         $class generateForward $sect
  1246.     }
  1247.     if [$this isGlobalType] {
  1248.         return
  1249.     }
  1250.     $sect append "[$this genTypeSignature]\n"
  1251.     $containedClassList foreach class {
  1252.         $sect append "[$class name] [$class name]\n"
  1253.     }
  1254.     $sect append "end type\n"
  1255. }
  1256.  
  1257. method PBVisualContainer::generateInstanceVars {this sect} {
  1258.     $this PBVisual::generateInstanceVars $sect
  1259.  
  1260.     $sect append "${PBCookie::controlClassMapSection}\n"
  1261.     $this generateControlClassMapping $sect
  1262. }
  1263.  
  1264. method PBVisualContainer::generateControlClassMapping {this sect} {
  1265.     $this PBVisual::generateControlClassMapping $sect 
  1266.     [$this containedClassSet] foreach class {
  1267.         $class generateControlClassMapping $sect
  1268.     }
  1269. }
  1270.  
  1271. method PBVisualContainer::genOnCreateBody {this} {
  1272.     if {[$this onCreateBody] == ""} {
  1273.         $this onCreateBody [TextSection new]
  1274.     }
  1275.     set sect [$this onCreateBody]
  1276.  
  1277.     if {[$this superClassName] != [$this builtinSuperClassName]} {
  1278.         set isDirectSubClassOfBuiltin 0
  1279.     } else {
  1280.         set isDirectSubClassOfBuiltin 1
  1281.     }
  1282.     set containedClassList [$this containedClassSet]
  1283.  
  1284.     #if {$isDirectSubClassOfBuiltin && [$containedClassList empty]} 
  1285.     #    do nothing
  1286.     #
  1287.     if {!$isDirectSubClassOfBuiltin && [$containedClassList empty]} {
  1288.         set classInfo [[PBBuiltinInfo::global] \
  1289.             getBuiltinClass [$this builtinSuperClassName]]
  1290.         if {[$this isGlobalType] && [$classInfo isGrContainer]} {
  1291.             $sect append "call [$this superClassName]::create\n"
  1292.         }
  1293.     } elseif {$isDirectSubClassOfBuiltin && ![$containedClassList empty]} {
  1294.         $containedClassList foreach class {
  1295.             $sect append "this.[$class name]=create [$class name]\n"
  1296.         }
  1297.         $sect append "this.[$this containerArray]\[\]=\{ "
  1298.         set first 1
  1299.         $containedClassList foreach class {
  1300.             if !$first {
  1301.                 $sect append ",&\n"
  1302.             } else {
  1303.                 set first 0
  1304.             }
  1305.             $sect append "this.[$class name]"
  1306.         }
  1307.         $sect append "\}\n"
  1308.     } elseif {!$isDirectSubClassOfBuiltin && ![$containedClassList empty]} {
  1309.         $sect append "int iCurrent\n"
  1310.         if [$this isGlobalType] {
  1311.             $sect append "call [$this superClassName]::create\n"
  1312.         }
  1313.         $containedClassList foreach class {
  1314.             $sect append "this.[$class name]=create [$class name]\n"
  1315.         }
  1316.         $sect append \
  1317.             "iCurrent=UpperBound(this.[$this containerArray])\n"
  1318.         set i 1
  1319.         $containedClassList foreach class {
  1320.             $sect append "this.[$this containerArray\
  1321.                 ]\[iCurrent+${i}\]=[$class name]\n"
  1322.             incr i
  1323.         }
  1324.     }
  1325.  
  1326.     $this PBVisual::genOnCreateBody
  1327. }
  1328.  
  1329. method PBVisualContainer::genOnDestroyBody {this} {
  1330.     if {[$this onDestroyBody] == ""} {
  1331.         $this onDestroyBody [TextSection new]
  1332.     }
  1333.     set sect [$this onDestroyBody]
  1334.  
  1335.     if {[$this superClassName] != [$this builtinSuperClassName]} {
  1336.         set isDirectSubClassOfBuiltin 0
  1337.     } else {
  1338.         set isDirectSubClassOfBuiltin 1
  1339.     }
  1340.     set containedClassList [$this containedClassSet]
  1341.  
  1342.     #if {$isDirectSubClassOfBuiltin && [$containedClassList empty]}
  1343.     #    do nothing
  1344.     #
  1345.     set classInfo [[PBBuiltinInfo::global] \
  1346.         getBuiltinClass [$this builtinSuperClassName]]
  1347.     if {!$isDirectSubClassOfBuiltin && [$this isGlobalType] &&
  1348.             [$classInfo isGrContainer]} {
  1349.         $sect append "call [$this superClassName]::destroy\n"
  1350.     }
  1351.     $containedClassList foreach class {
  1352.         $sect append "destroy(this.[$class name])\n"
  1353.     }
  1354.  
  1355.     $this PBVisual::genOnDestroyBody
  1356. }
  1357.  
  1358. method PBVisualContainer::findContainedClass {this name {recursive 0}} {
  1359.     [$this containedClassSet] foreach class {
  1360.         if {[$class name] == $name} {
  1361.             return $class
  1362.         }
  1363.         if {$recursive && [$class isA "PBVisualContainer"]} {
  1364.             set cl [$class findContainedClass $name $recursive]
  1365.             if {$cl != ""} {
  1366.                 return $cl
  1367.             }
  1368.         }
  1369.     }
  1370.  
  1371.     return ""
  1372. }
  1373.  
  1374. # Do not delete this line -- regeneration end marker
  1375.  
  1376. method PBVisualContainer::containedClassSet {this} {
  1377.     return [$this _containedClassSet]
  1378. }
  1379.  
  1380. method PBVisualContainer::addContainedClass {this newContainedClass} {
  1381.     [$this _containedClassSet] append $newContainedClass
  1382.     $newContainedClass _container $this
  1383. }
  1384.  
  1385. method PBVisualContainer::removeContainedClass {this oldContainedClass} {
  1386.     $oldContainedClass _container ""
  1387.     [$this _containedClassSet] removeValue $oldContainedClass
  1388. }
  1389.  
  1390. #---------------------------------------------------------------------------
  1391. #      File:           @(#)pbmenu.tcl    /main/hindenburg/1
  1392. #---------------------------------------------------------------------------
  1393.  
  1394. # Start user added include file section
  1395. # End user added include file section
  1396.  
  1397.  
  1398. Class PBMenu : {PBVisualContainer} {
  1399.     constructor
  1400.     method destructor
  1401.     method genOnCreateBody
  1402.     method getKind
  1403. }
  1404.  
  1405. constructor PBMenu {class this i_name ooplClass i_superClassName i_builtinSuperClassName} {
  1406.     set this [PBVisualContainer::constructor $class $this $i_name $ooplClass $i_superClassName $i_builtinSuperClassName]
  1407.     # Start constructor user section
  1408.     $this containerArray "Item"
  1409.     # End constructor user section
  1410.     return $this
  1411. }
  1412.  
  1413. method PBMenu::destructor {this} {
  1414.     # Start destructor user section
  1415.     # End destructor user section
  1416.     $this PBVisualContainer::destructor
  1417. }
  1418.  
  1419. method PBMenu::genOnCreateBody {this} {
  1420.     if {[$this onCreateBody] == ""} {
  1421.         $this onCreateBody [TextSection new]
  1422.     }
  1423.     set sect [$this onCreateBody]
  1424.     if [$this isGlobalType] {
  1425.         $sect append "[$this name]=this\n"
  1426.     }
  1427.     $this PBVisualContainer::genOnCreateBody
  1428. }
  1429.  
  1430. method PBMenu::getKind {this} {
  1431.     return ${PBClassKind::Menu}
  1432. }
  1433.  
  1434. # Do not delete this line -- regeneration end marker
  1435.  
  1436. #---------------------------------------------------------------------------
  1437. #      File:           @(#)pboperatio.tcl    /main/hindenburg/1
  1438. #---------------------------------------------------------------------------
  1439.  
  1440. # Start user added include file section
  1441. # End user added include file section
  1442.  
  1443.  
  1444. Class PBOperation : {PBFeature} {
  1445.     constructor
  1446.     method destructor
  1447.     method genParameterList
  1448.     method genSignature
  1449.     method addParameter
  1450.     method removeParameter
  1451.     attribute body
  1452.     attribute parameterSet
  1453. }
  1454.  
  1455. constructor PBOperation {class this i_name type} {
  1456.     set this [PBFeature::constructor $class $this $i_name $type]
  1457.     $this parameterSet [List new]
  1458.     # Start constructor user section
  1459.     # End constructor user section
  1460.     return $this
  1461. }
  1462.  
  1463. method PBOperation::destructor {this} {
  1464.     # Start destructor user section
  1465.     # End destructor user section
  1466.     $this PBFeature::destructor
  1467. }
  1468.  
  1469. method PBOperation::genParameterList {this} {
  1470.     set sect [TextSection new]
  1471.     set first 1
  1472.  
  1473.     [$this parameterSet] foreach parameter {
  1474.         if $first {
  1475.             set first 0
  1476.         } else {
  1477.             $sect append ", "
  1478.         }
  1479.         $parameter generate $sect
  1480.     }
  1481.  
  1482.     return $sect
  1483. }
  1484.  
  1485. method PBOperation::genSignature {this} {
  1486.     return "[$this name] ([[$this genParameterList] contents])"
  1487. }
  1488.  
  1489. # Do not delete this line -- regeneration end marker
  1490.  
  1491. method PBOperation::addParameter {this newParameter} {
  1492.     [$this parameterSet] append $newParameter
  1493.  
  1494. }
  1495.  
  1496. method PBOperation::removeParameter {this oldParameter} {
  1497.     [$this parameterSet] removeValue $oldParameter
  1498. }
  1499.  
  1500. #---------------------------------------------------------------------------
  1501. #      File:           @(#)pbwindow.tcl    /main/hindenburg/3
  1502. #---------------------------------------------------------------------------
  1503.  
  1504. # Start user added include file section
  1505. # End user added include file section
  1506.  
  1507.  
  1508. Class PBWindow : {PBVisualContainer} {
  1509.     constructor
  1510.     method destructor
  1511.     method genOnCreateBody
  1512.     method genOnDestroyBody
  1513.     method getKind
  1514.     attribute menuName
  1515. }
  1516.  
  1517. constructor PBWindow {class this i_name ooplClass i_superClassName i_builtinSuperClassName} {
  1518.     set this [PBVisualContainer::constructor $class $this $i_name $ooplClass $i_superClassName $i_builtinSuperClassName]
  1519.     $this menuName ""
  1520.     # Start constructor user section
  1521.     # End constructor user section
  1522.     return $this
  1523. }
  1524.  
  1525. method PBWindow::destructor {this} {
  1526.     # Start destructor user section
  1527.     # End destructor user section
  1528.     $this PBVisualContainer::destructor
  1529. }
  1530.  
  1531. method PBWindow::genOnCreateBody {this} {
  1532.     if {[$this onCreateBody] == ""} {
  1533.         $this onCreateBody [TextSection new]
  1534.     }
  1535.     set sect [$this onCreateBody]
  1536.  
  1537.     set menuName [$this menuName]
  1538.     if {$menuName != ""} {
  1539.         $sect append "if this.MenuName = \"${menuName}\"\
  1540.             then this.MenuID = create ${menuName}\n"
  1541.     }
  1542.     $this PBVisualContainer::genOnCreateBody
  1543. }
  1544.  
  1545. method PBWindow::genOnDestroyBody {this} {
  1546.     if {[$this onDestroyBody] == ""} {
  1547.         $this onDestroyBody [TextSection new]
  1548.     }
  1549.     set sect [$this onDestroyBody]
  1550.  
  1551.     if {[$this menuName] != ""} {
  1552.         $sect append "if IsValid(MenuID) then destroy(MenuID)\n"
  1553.     }
  1554.     $this PBVisualContainer::genOnDestroyBody
  1555. }
  1556.  
  1557. method PBWindow::getKind {this} {
  1558.     return ${PBClassKind::Window}
  1559. }
  1560.  
  1561. # Do not delete this line -- regeneration end marker
  1562.  
  1563. #---------------------------------------------------------------------------
  1564. #      File:           @(#)pbnametype.tcl    /main/hindenburg/2
  1565. #---------------------------------------------------------------------------
  1566.  
  1567. # Start user added include file section
  1568. # End user added include file section
  1569.  
  1570.  
  1571. Class PBNameType : {PBFeature} {
  1572.     constructor
  1573.     method destructor
  1574.     method generate
  1575.     attribute arrayDesc
  1576. }
  1577.  
  1578. constructor PBNameType {class this i_name type} {
  1579.     set this [PBFeature::constructor $class $this $i_name $type]
  1580.     $this arrayDesc ""
  1581.     # Start constructor user section
  1582.     # End constructor user section
  1583.     return $this
  1584. }
  1585.  
  1586. method PBNameType::destructor {this} {
  1587.     # Start destructor user section
  1588.     # End destructor user section
  1589.     $this PBFeature::destructor
  1590. }
  1591.  
  1592. method PBNameType::generate {this sect} {
  1593.     $sect append "[[$this type] generate] [$this name][$this arrayDesc]"
  1594. }
  1595.  
  1596. # Do not delete this line -- regeneration end marker
  1597.  
  1598. #---------------------------------------------------------------------------
  1599. #      File:           @(#)pbparamete.tcl    /main/hindenburg/1
  1600. #---------------------------------------------------------------------------
  1601.  
  1602. # Start user added include file section
  1603. # End user added include file section
  1604.  
  1605.  
  1606. Class PBParameter : {PBNameType} {
  1607.     constructor
  1608.     method destructor
  1609.     method generate
  1610.     attribute modifier
  1611. }
  1612.  
  1613. constructor PBParameter {class this i_name type modifier} {
  1614.     set this [PBNameType::constructor $class $this $i_name $type]
  1615.     $this modifier $modifier
  1616.     # Start constructor user section
  1617.     # End constructor user section
  1618.     return $this
  1619. }
  1620.  
  1621. method PBParameter::destructor {this} {
  1622.     # Start destructor user section
  1623.     # End destructor user section
  1624.     $this PBNameType::destructor
  1625. }
  1626.  
  1627. method PBParameter::generate {this sect} {
  1628.     if {[$this modifier] != ""} {
  1629.         set modifier [[$this modifier] generate]
  1630.         if {$modifier != ""} {
  1631.             $sect append "$modifier "
  1632.         }
  1633.     }
  1634.     $this PBNameType::generate $sect
  1635. }
  1636.  
  1637. # Do not delete this line -- regeneration end marker
  1638.  
  1639. #---------------------------------------------------------------------------
  1640. #      File:           @(#)pbclasscus.tcl    /main/hindenburg/2
  1641. #---------------------------------------------------------------------------
  1642.  
  1643. # Start user added include file section
  1644. # End user added include file section
  1645.  
  1646.  
  1647. Class PBClassCustomUserObject : {PBClass} {
  1648.     constructor
  1649.     method destructor
  1650.     method genTypeSignature
  1651.     method genOnCreateBody
  1652.     method genOnDestroyBody
  1653.     method getKind
  1654.     attribute isAutoInstantiate
  1655. }
  1656.  
  1657. constructor PBClassCustomUserObject {class this i_name ooplClass i_superClassName i_builtinSuperClassName} {
  1658.     set this [PBClass::constructor $class $this $i_name $ooplClass $i_superClassName $i_builtinSuperClassName]
  1659.     $this isAutoInstantiate 0
  1660.     # Start constructor user section
  1661.     # End constructor user section
  1662.     return $this
  1663. }
  1664.  
  1665. method PBClassCustomUserObject::destructor {this} {
  1666.     # Start destructor user section
  1667.     # End destructor user section
  1668.     $this PBClass::destructor
  1669. }
  1670.  
  1671. method PBClassCustomUserObject::genTypeSignature {this} {
  1672.     set signature [$this PBClass::genTypeSignature]
  1673.     if [$this isAutoInstantiate] {
  1674.         set signature "$signature autoinstantiate"
  1675.     }
  1676.     return $signature
  1677. }
  1678.  
  1679. method PBClassCustomUserObject::genOnCreateBody {this} {
  1680.     set sect [TextSection new]
  1681.  
  1682.     $this onCreateBody $sect
  1683.     $sect append "TriggerEvent( this, \"constructor\" )\n"
  1684. }
  1685.  
  1686. method PBClassCustomUserObject::genOnDestroyBody {this} {
  1687.     set sect [TextSection new]
  1688.  
  1689.     $this onDestroyBody $sect
  1690.     $sect append "TriggerEvent( this, \"destructor\" )\n"
  1691. }
  1692.  
  1693. method PBClassCustomUserObject::getKind {this} {
  1694.     return ${PBClassKind::CCUserObject}
  1695. }
  1696.  
  1697. # Do not delete this line -- regeneration end marker
  1698.  
  1699. #---------------------------------------------------------------------------
  1700. #      File:           @(#)pbvariable.tcl    /main/hindenburg/1
  1701. #---------------------------------------------------------------------------
  1702.  
  1703. # Start user added include file section
  1704. # End user added include file section
  1705.  
  1706.  
  1707. Class PBVariable : {PBNameType} {
  1708.     constructor
  1709.     method destructor
  1710.     method generate
  1711.     attribute defaultValue
  1712.     attribute isShared
  1713.     attribute isConstant
  1714.     attribute access
  1715. }
  1716.  
  1717. constructor PBVariable {class this i_name type access} {
  1718.     set this [PBNameType::constructor $class $this $i_name $type]
  1719.     $this defaultValue ""
  1720.     $this isShared 0
  1721.     $this isConstant 0
  1722.     $this access $access
  1723.     # Start constructor user section
  1724.     # End constructor user section
  1725.     return $this
  1726. }
  1727.  
  1728. method PBVariable::destructor {this} {
  1729.     # Start destructor user section
  1730.     # End destructor user section
  1731.     $this PBNameType::destructor
  1732. }
  1733.  
  1734. method PBVariable::generate {this sect} {
  1735.     if [$this isConstant] {
  1736.         $sect append "constant "
  1737.         set access [[$this access] PBAccess::generate]
  1738.     } else {
  1739.         set access [[$this access] generate]
  1740.     }
  1741.     if {![$this isShared] && $access != ""} {
  1742.         $sect append "$access "
  1743.     }
  1744.     $this PBNameType::generate $sect
  1745.     if {[$this defaultValue] != ""} {
  1746.         $sect append " = [$this defaultValue]"
  1747.     }
  1748. }
  1749.  
  1750. # Do not delete this line -- regeneration end marker
  1751.  
  1752. #---------------------------------------------------------------------------
  1753. #      File:           @(#)pbfunction.tcl    /main/hindenburg/2
  1754. #---------------------------------------------------------------------------
  1755.  
  1756. # Start user added include file section
  1757. # End user added include file section
  1758.  
  1759.  
  1760. Class PBFunction : {PBOperation} {
  1761.     constructor
  1762.     method destructor
  1763.     method generate
  1764.     attribute access
  1765. }
  1766.  
  1767. constructor PBFunction {class this i_name type access} {
  1768.     set this [PBOperation::constructor $class $this $i_name $type]
  1769.     $this access $access
  1770.     # Start constructor user section
  1771.     # End constructor user section
  1772.     return $this
  1773. }
  1774.  
  1775. method PBFunction::destructor {this} {
  1776.     # Start destructor user section
  1777.     # End destructor user section
  1778.     $this PBOperation::destructor
  1779. }
  1780.  
  1781. method PBFunction::generate {this declSect defSect} {
  1782.     set funcStart ""
  1783.  
  1784.     set access [[$this access] generate]
  1785.     if {$access != ""} {
  1786.         set funcStart "$access "
  1787.     }
  1788.     set type [[$this type] generate]
  1789.     if {$type != ""} {
  1790.         set funcStart "${funcStart}function $type "
  1791.     } else {
  1792.         set funcStart "${funcStart}subroutine "
  1793.     }
  1794.     set funcStart "${funcStart}[$this genSignature]"
  1795.  
  1796.     $declSect append "${funcStart}\n"
  1797.     $defSect append "${funcStart};"
  1798.     if {[$this body] != ""} {
  1799.         $defSect appendSect [$this body]
  1800.     } else {
  1801.         $defSect append "${PBCookie::implementThisFunction}\n"
  1802.         if {$type != ""} {
  1803.             $defSect append "$type dummy\n"
  1804.             $defSect append "return dummy\n"
  1805.         }
  1806.     }
  1807.     if {$type != ""} {
  1808.         $defSect append "end function\n"
  1809.     } else {
  1810.         $defSect append "end subroutine\n"
  1811.     }
  1812. }
  1813.  
  1814. # Do not delete this line -- regeneration end marker
  1815.  
  1816. #---------------------------------------------------------------------------
  1817. #      File:           @(#)pbevent.tcl    /main/hindenburg/5
  1818. #---------------------------------------------------------------------------
  1819.  
  1820. # Start user added include file section
  1821. # End user added include file section
  1822.  
  1823.  
  1824. Class PBEvent : {PBOperation} {
  1825.     constructor
  1826.     method destructor
  1827.     method genSignature
  1828.     method generate
  1829.     attribute extendAncestorScript
  1830. }
  1831.  
  1832. constructor PBEvent {class this i_name type} {
  1833.     set this [PBOperation::constructor $class $this $i_name $type]
  1834.     $this extendAncestorScript 0
  1835.     # Start constructor user section
  1836.     # End constructor user section
  1837.     return $this
  1838. }
  1839.  
  1840. method PBEvent::destructor {this} {
  1841.     # Start destructor user section
  1842.     # End destructor user section
  1843.     $this PBOperation::destructor
  1844. }
  1845.  
  1846. method PBEvent::genSignature {this} {
  1847.     set paramList [$this parameterSet]
  1848.     if ![$paramList empty] {
  1849.         set firstParam [$paramList index]
  1850.         set paramType [[$firstParam type] name]
  1851.         if {$paramType == "eventid"} {
  1852.             set paramName [$firstParam name]
  1853.             return "[$this name] $paramName"
  1854.         }
  1855.     }
  1856.  
  1857.     return [$this PBOperation::genSignature]
  1858. }
  1859.  
  1860. method PBEvent::generate {this sect what} {
  1861.     if {$what == "eventDeclaration"} {
  1862.         $sect append "event "
  1863.         set type [[$this type] generate]
  1864.         if {$type != ""} {
  1865.             $sect append "type $type "
  1866.         }
  1867.         $sect append [$this genSignature]
  1868.     } else {
  1869.         # $what == "eventDefinition"
  1870.         $sect append "event [$this name]\;"
  1871.         if [$this extendAncestorScript] {
  1872.             $sect append "call super::[$this name]\;"
  1873.         }
  1874.         if {[$this body] != ""} {
  1875.             $sect appendSect [$this body]
  1876.         } else {
  1877.             $sect append "${PBCookie::implementThisEvent}\n"
  1878.             set type [[$this type] generate]
  1879.             if {$type != ""} {
  1880.                 $sect append "$type dummy\n"
  1881.                 $sect append "return dummy\n"
  1882.             }
  1883.         }
  1884.         $sect append "end event\n"
  1885.     }
  1886. }
  1887.  
  1888. # Do not delete this line -- regeneration end marker
  1889.  
  1890. #---------------------------------------------------------------------------
  1891. #      File:           @(#)pbclasssta.tcl    /main/hindenburg/1
  1892. #---------------------------------------------------------------------------
  1893.  
  1894. # Start user added include file section
  1895. # End user added include file section
  1896.  
  1897.  
  1898. Class PBClassStandardUserObject : {PBClass} {
  1899.     constructor
  1900.     method destructor
  1901.     method genOnCreateBody
  1902.     method genOnDestroyBody
  1903.     method getKind
  1904. }
  1905.  
  1906. constructor PBClassStandardUserObject {class this i_name ooplClass i_superClassName i_builtinSuperClassName} {
  1907.     set this [PBClass::constructor $class $this $i_name $ooplClass $i_superClassName $i_builtinSuperClassName]
  1908.     # Start constructor user section
  1909.     # End constructor user section
  1910.     return $this
  1911. }
  1912.  
  1913. method PBClassStandardUserObject::destructor {this} {
  1914.     # Start destructor user section
  1915.     # End destructor user section
  1916.     $this PBClass::destructor
  1917. }
  1918.  
  1919. method PBClassStandardUserObject::genOnCreateBody {this} {
  1920.     set sect [TextSection new]
  1921.  
  1922.     $this onCreateBody $sect
  1923.     $sect append "call [$this builtinSuperClassName]::create\n"
  1924.     $sect append "TriggerEvent( this, \"constructor\" )\n"
  1925. }
  1926.  
  1927. method PBClassStandardUserObject::genOnDestroyBody {this} {
  1928.     set sect [TextSection new]
  1929.  
  1930.     $this onDestroyBody $sect
  1931.     $sect append "call [$this builtinSuperClassName]::destroy\n"
  1932.     $sect append "TriggerEvent( this, \"destructor\" )\n"
  1933. }
  1934.  
  1935. method PBClassStandardUserObject::getKind {this} {
  1936.     return ${PBClassKind::CSUserObject}
  1937. }
  1938.  
  1939. # Do not delete this line -- regeneration end marker
  1940.  
  1941. #---------------------------------------------------------------------------
  1942. #      File:           @(#)pbstructur.tcl    /main/hindenburg/2
  1943. #---------------------------------------------------------------------------
  1944.  
  1945. # Start user added include file section
  1946. # End user added include file section
  1947.  
  1948.  
  1949. Class PBStructure : {PBDefinition} {
  1950.     constructor
  1951.     method destructor
  1952.     method generate
  1953.     method getKind
  1954.     method getGlobalDefinition
  1955.     method theClass
  1956.     method addField
  1957.     method removeField
  1958.     attribute _theClass
  1959.     attribute fieldSet
  1960. }
  1961.  
  1962. constructor PBStructure {class this i_name ooplClass} {
  1963.     set this [PBDefinition::constructor $class $this $i_name $ooplClass]
  1964.     $this fieldSet [List new]
  1965.     # Start constructor user section
  1966.     # End constructor user section
  1967.     return $this
  1968. }
  1969.  
  1970. method PBStructure::destructor {this} {
  1971.     # Start destructor user section
  1972.     # End destructor user section
  1973.     $this PBDefinition::destructor
  1974. }
  1975.  
  1976. method PBStructure::generate {this sect} {
  1977.     if [$this isGlobalType] {
  1978.         $sect append "global "
  1979.     }
  1980.     $sect append "type [$this name] from structure\n"
  1981.     [$this fieldSet] foreach field {
  1982.         $sect append "\t"
  1983.         $field generate $sect
  1984.         $sect append "\n"
  1985.     }
  1986.     $sect append "end type\n"
  1987. }
  1988.  
  1989. method PBStructure::getKind {this} {
  1990.     return ${PBClassKind::Structure}
  1991. }
  1992.  
  1993. method PBStructure::getGlobalDefinition {this} {
  1994.     set class [$this theClass]
  1995.     if {$class != ""} {
  1996.         return $class
  1997.     }
  1998.     return $this
  1999. }
  2000.  
  2001. # Do not delete this line -- regeneration end marker
  2002.  
  2003. method PBStructure::theClass {this args} {
  2004.     if {$args == ""} {
  2005.         return [$this _theClass]
  2006.     }
  2007.     set ref [$this _theClass]
  2008.     if {$ref != ""} {
  2009.         [$ref _objectStructureSet] removeValue $this
  2010.     }
  2011.     set obj [lindex $args 0]
  2012.     if {$obj != ""} {
  2013.         [$obj _objectStructureSet] append $this
  2014.     }
  2015.     $this _theClass $obj
  2016. }
  2017.  
  2018. method PBStructure::addField {this newField} {
  2019.     [$this fieldSet] append $newField
  2020.  
  2021. }
  2022.  
  2023. method PBStructure::removeField {this oldField} {
  2024.     [$this fieldSet] removeValue $oldField
  2025. }
  2026.  
  2027. #---------------------------------------------------------------------------
  2028. #      File:           @(#)pbconstruc.tcl    /main/hindenburg/1
  2029. #---------------------------------------------------------------------------
  2030.  
  2031. # Start user added include file section
  2032. # End user added include file section
  2033.  
  2034.  
  2035. Class PBConstructor : {PBEvent} {
  2036.     constructor
  2037.     method destructor
  2038.     method generate
  2039.     attribute preBody
  2040. }
  2041.  
  2042. constructor PBConstructor {class this i_name type} {
  2043.     set this [PBEvent::constructor $class $this $i_name $type]
  2044.     # Start constructor user section
  2045.     # End constructor user section
  2046.     return $this
  2047. }
  2048.  
  2049. method PBConstructor::destructor {this} {
  2050.     # Start destructor user section
  2051.     # End destructor user section
  2052.     $this PBEvent::destructor
  2053. }
  2054.  
  2055. method PBConstructor::generate {this sect what} {
  2056.     if {$what == "eventDefinition"} {
  2057.         # Add cookie strings and preBody to body
  2058.         #
  2059.         set newBody [TextSection new]
  2060.  
  2061.         if {[$this preBody] != ""} {
  2062.             $newBody appendSect [$this preBody]
  2063.         }
  2064.         $newBody append "${PBCookie::startUserSection}\n"
  2065.         if {[$this body] != ""} {
  2066.             $newBody appendSect [$this body]
  2067.         }
  2068.         $newBody append "${PBCookie::endUserSection}\n"
  2069.         $this body $newBody
  2070.     }
  2071.  
  2072.     $this PBEvent::generate $sect $what
  2073. }
  2074.  
  2075. # Do not delete this line -- regeneration end marker
  2076.  
  2077. #---------------------------------------------------------------------------
  2078. #      File:           @(#)pbdestruct.tcl    /main/hindenburg/1
  2079. #---------------------------------------------------------------------------
  2080.  
  2081. # Start user added include file section
  2082. # End user added include file section
  2083.  
  2084.  
  2085. Class PBDestructor : {PBEvent} {
  2086.     constructor
  2087.     method destructor
  2088.     method generate
  2089.     attribute postBody
  2090. }
  2091.  
  2092. constructor PBDestructor {class this i_name type} {
  2093.     set this [PBEvent::constructor $class $this $i_name $type]
  2094.     # Start constructor user section
  2095.     # End constructor user section
  2096.     return $this
  2097. }
  2098.  
  2099. method PBDestructor::destructor {this} {
  2100.     # Start destructor user section
  2101.     # End destructor user section
  2102.     $this PBEvent::destructor
  2103. }
  2104.  
  2105. method PBDestructor::generate {this sect what} {
  2106.     if {$what == "eventDefinition"} {
  2107.         # Add cookie strings and postBody to body
  2108.         #
  2109.         set newBody [TextSection new]
  2110.  
  2111.         $newBody append "${PBCookie::startUserSection}\n"
  2112.         if {[$this body] != ""} {
  2113.             $newBody appendSect [$this body]
  2114.         }
  2115.         $newBody append "${PBCookie::endUserSection}\n"
  2116.         if {[$this postBody] != ""} {
  2117.             $newBody appendSect [$this postBody]
  2118.         }
  2119.         $this body $newBody
  2120.     }
  2121.  
  2122.     $this PBEvent::generate $sect $what
  2123. }
  2124.  
  2125. # Do not delete this line -- regeneration end marker
  2126.  
  2127. #---------------------------------------------------------------------------
  2128. #      File:           @(#)pbvaracces.tcl    /main/hindenburg/1
  2129. #---------------------------------------------------------------------------
  2130.  
  2131. # Start user added include file section
  2132. # End user added include file section
  2133.  
  2134.  
  2135. Class PBVarAccess : {PBAccess} {
  2136.     constructor
  2137.     method destructor
  2138.     method generate
  2139.     attribute readAccess
  2140.     attribute writeAccess
  2141. }
  2142.  
  2143. constructor PBVarAccess {class this i_accessRight i_readAccess i_writeAccess} {
  2144.     set this [PBAccess::constructor $class $this $i_accessRight]
  2145.     $this readAccess $i_readAccess
  2146.     $this writeAccess $i_writeAccess
  2147.     # Start constructor user section
  2148.     # End constructor user section
  2149.     return $this
  2150. }
  2151.  
  2152. method PBVarAccess::destructor {this} {
  2153.     # Start destructor user section
  2154.     # End destructor user section
  2155.     $this PBAccess::destructor
  2156. }
  2157.  
  2158. method PBVarAccess::generate {this} {
  2159.     set access [$this PBAccess::generate]
  2160.     if {[$this readAccess] != ""} {
  2161.         set access "${access} [$this readAccess]"
  2162.     }
  2163.     if {[$this writeAccess] != ""} {
  2164.         set access "${access} [$this writeAccess]"
  2165.     }
  2166.     return [string trim $access]
  2167. }
  2168.  
  2169. # Do not delete this line -- regeneration end marker
  2170.  
  2171. #---------------------------------------------------------------------------
  2172. #      File:           @(#)pbvisualcu.tcl    /main/hindenburg/2
  2173. #---------------------------------------------------------------------------
  2174.  
  2175. # Start user added include file section
  2176. # End user added include file section
  2177.  
  2178.  
  2179. Class PBVisualCustomUserObject : {PBVisualContainer} {
  2180.     constructor
  2181.     method destructor
  2182.     method genTypeSignature
  2183.     method getKind
  2184.     attribute isAutoInstantiate
  2185. }
  2186.  
  2187. constructor PBVisualCustomUserObject {class this i_name ooplClass i_superClassName i_builtinSuperClassName} {
  2188.     set this [PBVisualContainer::constructor $class $this $i_name $ooplClass $i_superClassName $i_builtinSuperClassName]
  2189.     $this isAutoInstantiate 0
  2190.     # Start constructor user section
  2191.     # End constructor user section
  2192.     return $this
  2193. }
  2194.  
  2195. method PBVisualCustomUserObject::destructor {this} {
  2196.     # Start destructor user section
  2197.     # End destructor user section
  2198.     $this PBVisualContainer::destructor
  2199. }
  2200.  
  2201. method PBVisualCustomUserObject::genTypeSignature {this} {
  2202.     set signature [$this PBVisual::genTypeSignature]
  2203.     if [$this isAutoInstantiate] {
  2204.         set signature "$signature autoinstantiate"
  2205.     }
  2206.     return $signature
  2207. }
  2208.  
  2209. method PBVisualCustomUserObject::getKind {this} {
  2210.     return ${PBClassKind::VCUserObject}
  2211. }
  2212.  
  2213. # Do not delete this line -- regeneration end marker
  2214.  
  2215. #---------------------------------------------------------------------------
  2216. #      File:           @(#)pbvisualst.tcl    /main/hindenburg/1
  2217. #---------------------------------------------------------------------------
  2218.  
  2219. # Start user added include file section
  2220. # End user added include file section
  2221.  
  2222.  
  2223.  
  2224. Class PBVisualStandardUserObject : {PBVisualContainer} {
  2225.     constructor
  2226.     method destructor
  2227.     method getKind
  2228. }
  2229.  
  2230. constructor PBVisualStandardUserObject {class this i_name ooplClass i_superClassName i_builtinSuperClassName} {
  2231.     set this [PBVisualContainer::constructor $class $this $i_name $ooplClass $i_superClassName $i_builtinSuperClassName]
  2232.     # Start constructor user section
  2233.     # End constructor user section
  2234.     return $this
  2235. }
  2236.  
  2237. method PBVisualStandardUserObject::destructor {this} {
  2238.     # Start destructor user section
  2239.     # End destructor user section
  2240.     $this PBVisualContainer::destructor
  2241. }
  2242.  
  2243. method PBVisualStandardUserObject::getKind {this} {
  2244.     return ${PBClassKind::VSUserObject}
  2245. }
  2246.  
  2247. # Do not delete this line -- regeneration end marker
  2248.  
  2249.