home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / fortetgt.tcl < prev    next >
Text File  |  1997-06-06  |  59KB  |  2,236 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            : fortetgt.tcl
  17. #       Author          : 
  18. #       Original date   : May 1997
  19. #       Description     : Classes for code generation
  20. #
  21. #---------------------------------------------------------------------------
  22.  
  23. #---------------------------------------------------------------------------
  24. #      File:           @(#)ftcompitem.tcl    /main/hindenburg/2
  25. #---------------------------------------------------------------------------
  26.  
  27. # Start user added include file section
  28. # End user added include file section
  29.  
  30.  
  31. Class FTCompItem : {GCObject} {
  32.     constructor
  33.     method destructor
  34.     method generate
  35.     method composite
  36.     attribute item
  37.     attribute type
  38.     attribute _composite
  39. }
  40.  
  41. constructor FTCompItem {class this i_item type composite} {
  42.     set this [GCObject::constructor $class $this]
  43.     $this item $i_item
  44.     $this type $type
  45.     $this _composite $composite
  46.     [$composite _itemSet] append $this
  47.     # Start constructor user section
  48.     # End constructor user section
  49.     return $this
  50. }
  51.  
  52. method FTCompItem::destructor {this} {
  53.     # Start destructor user section
  54.     # End destructor user section
  55. }
  56.  
  57. method FTCompItem::generate {this sect} {
  58.     set idx [[[$this composite] itemSet] search -exact $this]
  59.     if {$idx != 0} {
  60.     $sect append ";\n"
  61.     }
  62.     [$this type] generate "[$this item]" $sect [$this composite]
  63. }
  64.  
  65. # Do not delete this line -- regeneration end marker
  66.  
  67. method FTCompItem::composite {this args} {
  68.     if {$args == ""} {
  69.         return [$this _composite]
  70.     }
  71.     set ref [$this _composite]
  72.     if {$ref != ""} {
  73.         [$ref _itemSet] removeValue $this
  74.     }
  75.     set obj [lindex $args 0]
  76.     if {$obj != ""} {
  77.         [$obj _itemSet] append $this
  78.     }
  79.     $this _composite $obj
  80. }
  81.  
  82. #---------------------------------------------------------------------------
  83. #      File:           @(#)ftenumitem.tcl    /main/hindenburg/1
  84. #---------------------------------------------------------------------------
  85.  
  86. # Start user added include file section
  87. # End user added include file section
  88.  
  89.  
  90. Class FTEnumItem : {GCObject} {
  91.     constructor
  92.     method destructor
  93.     method generate
  94.     method enum
  95.     attribute item
  96.     attribute value
  97.     attribute _enum
  98. }
  99.  
  100. constructor FTEnumItem {class this i_item enum} {
  101.     set this [GCObject::constructor $class $this]
  102.     $this item $i_item
  103.     $this _enum $enum
  104.     [$enum _itemSet] append $this
  105.     # Start constructor user section
  106.     # End constructor user section
  107.     return $this
  108. }
  109.  
  110. method FTEnumItem::destructor {this} {
  111.     # Start destructor user section
  112.     # End destructor user section
  113. }
  114.  
  115. method FTEnumItem::generate {this sect} {
  116.     set idx [[[$this enum] itemSet] search -exact $this]
  117.     if {$idx != 0} {
  118.     $sect append ",\n"
  119.     }
  120.     $sect append "[$this item]"
  121.     if {[$this value] != ""} {
  122.     $sect append " = [$this value]"
  123.     }
  124. }
  125.  
  126. # Do not delete this line -- regeneration end marker
  127.  
  128. method FTEnumItem::enum {this args} {
  129.     if {$args == ""} {
  130.         return [$this _enum]
  131.     }
  132.     set ref [$this _enum]
  133.     if {$ref != ""} {
  134.         [$ref _itemSet] removeValue $this
  135.     }
  136.     set obj [lindex $args 0]
  137.     if {$obj != ""} {
  138.         [$obj _itemSet] append $this
  139.     }
  140.     $this _enum $obj
  141. }
  142.  
  143. #---------------------------------------------------------------------------
  144. #      File:           @(#)ftmodel.tcl    /main/hindenburg/4
  145. #---------------------------------------------------------------------------
  146.  
  147. # Start user added include file section
  148. # End user added include file section
  149.  
  150.  
  151. Class FTModel : {GCObject} {
  152.     constructor
  153.     method destructor
  154.     method findDefinition
  155.     method generate
  156.     method definitionSet
  157.     method addDefinition
  158.     method removeDefinition
  159.     attribute _definitionSet
  160. }
  161.  
  162. constructor FTModel {class this} {
  163.     set this [GCObject::constructor $class $this]
  164.     $this _definitionSet [List new]
  165.     # Start constructor user section
  166.     # End constructor user section
  167.     return $this
  168. }
  169.  
  170. method FTModel::destructor {this} {
  171.     # Start destructor user section
  172.     # End destructor user section
  173. }
  174.  
  175. method FTModel::findDefinition {this name {isSynthetic 0}} {
  176.     [$this definitionSet] foreach definition {
  177.     if {[$definition name] == $name && [$definition isSynthetic] == $isSynthetic} {
  178.         return $definition
  179.     }
  180.     }
  181.     return ""
  182. }
  183.  
  184. method FTModel::generate {this typeToClassDict} {
  185.     [$this definitionSet] foreach definition {
  186.     if {[$definition isSynthetic]} {
  187.         continue
  188.     }
  189.     $definition generate
  190.     set sectDict [Dictionary new]
  191.     $sectDict set "cex" [$definition getGenSect]
  192.     $sectDict set "hex" [$definition getGenSect DECL]
  193.     $typeToClassDict set [$definition ooplClass] $sectDict
  194.     }
  195. }
  196.  
  197. # Do not delete this line -- regeneration end marker
  198.  
  199. method FTModel::definitionSet {this} {
  200.     return [$this _definitionSet]
  201. }
  202.  
  203. method FTModel::addDefinition {this newDefinition} {
  204.     [$this _definitionSet] append $newDefinition
  205.     $newDefinition _model $this
  206. }
  207.  
  208. method FTModel::removeDefinition {this oldDefinition} {
  209.     $oldDefinition _model ""
  210.     [$this _definitionSet] removeValue $oldDefinition
  211. }
  212.  
  213. #---------------------------------------------------------------------------
  214. #      File:           @(#)ftobject.tcl    /main/hindenburg/4
  215. #---------------------------------------------------------------------------
  216.  
  217. # Start user added include file section
  218. # End user added include file section
  219.  
  220.  
  221. Class FTObject : {GCObject} {
  222.     constructor
  223.     method destructor
  224.     method getPropValue
  225.     method setPropValue
  226.     method removePropValue
  227.     attribute name
  228.     attribute propValue
  229. }
  230.  
  231. constructor FTObject {class this i_name} {
  232.     set this [GCObject::constructor $class $this]
  233.     $this name $i_name
  234.     $this propValue [Dictionary new]
  235.     # Start constructor user section
  236.     # End constructor user section
  237.     return $this
  238. }
  239.  
  240. method FTObject::destructor {this} {
  241.     # Start destructor user section
  242.     # End destructor user section
  243. }
  244.  
  245. # Do not delete this line -- regeneration end marker
  246.  
  247. method FTObject::getPropValue {this name} {
  248.     return [[$this propValue] set $name]
  249. }
  250.  
  251. method FTObject::setPropValue {this name newPropValue} {
  252.     [$this propValue] set $name $newPropValue
  253. }
  254.  
  255. method FTObject::removePropValue {this name} {
  256.     [$this propValue] unset $name
  257. }
  258.  
  259. #---------------------------------------------------------------------------
  260. #      File:           @(#)ftsectionl.tcl    /main/hindenburg/2
  261. #---------------------------------------------------------------------------
  262.  
  263. # Start user added include file section
  264. # End user added include file section
  265.  
  266.  
  267. Class FTSectionList : {GCObject} {
  268.     constructor
  269.     method destructor
  270.     method addSects
  271.     method getSection
  272.     method setSection
  273.     method removeSection
  274.     attribute section
  275. }
  276.  
  277. constructor FTSectionList {class this} {
  278.     set this [GCObject::constructor $class $this]
  279.     $this section [Dictionary new]
  280.     # Start constructor user section
  281.     # End constructor user section
  282.     return $this
  283. }
  284.  
  285. method FTSectionList::destructor {this} {
  286.     # Start destructor user section
  287.     # End destructor user section
  288. }
  289.  
  290. method FTSectionList::addSects {this nameList} {
  291.     foreach name $nameList {
  292.     if {[string match __*__ $name]} {
  293.         # this is some ruler, like __DEF_ONLY__
  294.         continue
  295.     }
  296.     if {[$this getSection $name] == ""} {
  297.         $this setSection $name [TextSection new]
  298.     }
  299.     }
  300. }
  301.  
  302. # Do not delete this line -- regeneration end marker
  303.  
  304. method FTSectionList::getSection {this name} {
  305.     return [[$this section] set $name]
  306. }
  307.  
  308. method FTSectionList::setSection {this name newSection} {
  309.     [$this section] set $name $newSection
  310. }
  311.  
  312. method FTSectionList::removeSection {this name} {
  313.     [$this section] unset $name
  314. }
  315.  
  316. #---------------------------------------------------------------------------
  317. #      File:           @(#)fttype.tcl    /main/hindenburg/5
  318. #---------------------------------------------------------------------------
  319.  
  320. # Start user added include file section
  321. # End user added include file section
  322.  
  323.  
  324. Class FTType : {GCObject} {
  325.     constructor
  326.     method destructor
  327.     method isArray
  328.     method isClassType
  329.     method getTypeName
  330.     method generate
  331.     attribute name
  332.     attribute isClass
  333.     attribute isPointer
  334.     attribute otherModifier
  335.     attribute arraySize
  336.     attribute classType
  337. }
  338.  
  339. constructor FTType {class this} {
  340.     set this [GCObject::constructor $class $this]
  341.     $this isClass -1
  342.     $this isPointer 0
  343.     $this arraySize -1
  344.     # Start constructor user section
  345.     # End constructor user section
  346.     return $this
  347. }
  348.  
  349. method FTType::destructor {this} {
  350.     # Start destructor user section
  351.     # End destructor user section
  352. }
  353.  
  354. method FTType::isArray {this {size -1}} {
  355.     if {$size < 1} {
  356.     if {[$this arraySize] != -1} {
  357.         return 1
  358.     }
  359.     return 0
  360.     }
  361.  
  362.     if {$size == 0} {
  363.     $this arraySize -1
  364.     } else {
  365.     $this arraySize $size
  366.     }
  367. }
  368.  
  369. method FTType::isClassType {this} {
  370.     if {[$this isPointer]} {
  371.     return 0
  372.     }
  373.     if {[$this isClass] != -1} {
  374.     return [$this isClass]
  375.     }
  376.  
  377.     # take a guess
  378.     if {[$this classType] == "" || [$this otherModifier] != ""} {
  379.     return 0
  380.     }
  381.     return 1
  382. }
  383.  
  384. method FTType::getTypeName {this curClass} {
  385.     if {[$this classType] != ""} {
  386.     set typeName [[$this classType] name]
  387.     set typeSysName [[$this classType] systemName]
  388.     if {$typeSysName == ""} {
  389.         $this name $typeName
  390.     } else {
  391.         $this name "$typeSysName.$typeName"
  392.     }
  393.     }
  394.     if {[$this classType] == "" || ![$this isClassType]} {
  395.     if {[$this name] == ""} {
  396.         set typeName "no_type"
  397.     } else {
  398.         set typeName [$this name]
  399.     }
  400.  
  401.     if {[$this isArray]} {
  402.         set typeName "array\[[$this arraySize]\] of $typeName"
  403.     }
  404.     } else {
  405.     $curClass addInclude $typeSysName
  406.     $curClass addForward $typeName [[$this classType] isMapped]
  407.     if {$typeSysName != ""} {
  408.         set typeName $typeSysName.$typeName
  409.     }
  410.  
  411.     if {[$this isArray]} {
  412.         set arrName Array
  413.         if {[$this arraySize] > 255} {
  414.         set arrName "Large${arrName}"
  415.         }
  416.         $curClass addInclude Framework
  417.         set typeName "Framework.$arrName of $typeName"
  418.     }
  419.     }
  420.  
  421.     if {[$this isPointer]} {
  422.     set typeName "pointer to $typeName"
  423.     }
  424.  
  425.     # if otherModifier is set, then
  426.     #    - '$name' is replaced by $typeName
  427.     #    - if there is no $name, then otherModifier is placed before $typeName
  428.     #
  429.     if {[$this otherModifier] != ""} {
  430.     if {[regsub -all {\$name} [$this otherModifier] $typeName new]} {
  431.         set typeName $new
  432.     } else {
  433.         set typeName "[$this otherModifier] $typeName"
  434.     }
  435.     }
  436.  
  437.     return $typeName
  438. }
  439.  
  440. method FTType::generate {this varName sect curClass} {
  441.     set type [$this getTypeName $curClass]
  442.     if {$varName != ""} {
  443.     $sect append $varName
  444.     if {$type != ""} {
  445.         $sect append ": $type"
  446.     }
  447.     return
  448.     }
  449.  
  450.     if {$type != ""} {
  451.     $sect append $type
  452.     }
  453. }
  454.  
  455. # Do not delete this line -- regeneration end marker
  456.  
  457. #---------------------------------------------------------------------------
  458. #      File:           @(#)ftdefiniti.tcl    /main/hindenburg/2
  459. #---------------------------------------------------------------------------
  460.  
  461. # Start user added include file section
  462. # End user added include file section
  463.  
  464.  
  465. Class FTDefinition : {FTObject} {
  466.     constructor
  467.     method destructor
  468.     method model
  469.     attribute _model
  470.     attribute ooplClass
  471. }
  472.  
  473. constructor FTDefinition {class this i_name model} {
  474.     set this [FTObject::constructor $class $this $i_name]
  475.     $this _model $model
  476.     [$model _definitionSet] append $this
  477.     # Start constructor user section
  478.     # End constructor user section
  479.     return $this
  480. }
  481.  
  482. method FTDefinition::destructor {this} {
  483.     # Start destructor user section
  484.     # End destructor user section
  485.     $this FTObject::destructor
  486. }
  487.  
  488. # Do not delete this line -- regeneration end marker
  489.  
  490. method FTDefinition::model {this args} {
  491.     if {$args == ""} {
  492.         return [$this _model]
  493.     }
  494.     set ref [$this _model]
  495.     if {$ref != ""} {
  496.         [$ref _definitionSet] removeValue $this
  497.     }
  498.     set obj [lindex $args 0]
  499.     if {$obj != ""} {
  500.         [$obj _definitionSet] append $this
  501.     }
  502.     $this _model $obj
  503. }
  504.  
  505. #---------------------------------------------------------------------------
  506. #      File:           @(#)ftclass.tcl    /main/hindenburg/6
  507. #---------------------------------------------------------------------------
  508.  
  509. # Start user added include file section
  510. # End user added include file section
  511.  
  512.  
  513. Class FTClass : {FTDefinition} {
  514.     constructor
  515.     method destructor
  516.     method addInclude
  517.     method addForward
  518.     method getGenSect
  519.     method findMethods
  520.     method findMethodsX
  521.     method attrSet
  522.     method addAttr
  523.     method removeAttr
  524.     method methSet
  525.     method addMeth
  526.     method removeMeth
  527.     method addSectName
  528.     method removeSectName
  529.     attribute systemName
  530.     attribute isSynthetic
  531.     attribute isMapped
  532.     attribute kind
  533.     attribute _attrSet
  534.     attribute _methSet
  535.     attribute super
  536.     attribute includeSet
  537.     attribute forwardSet
  538.     attribute mappedForwardSet
  539.     attribute sectNameSet
  540.     attribute sections
  541. }
  542.  
  543. constructor FTClass {class this i_name model i_systemName i_isSynthetic} {
  544.     set this [FTDefinition::constructor $class $this $i_name $model]
  545.     $this isMapped 0
  546.     $this kind "CLASS"
  547.     $this systemName $i_systemName
  548.     $this isSynthetic $i_isSynthetic
  549.     $this _attrSet [List new]
  550.     $this _methSet [List new]
  551.     $this includeSet [List new]
  552.     $this forwardSet [List new]
  553.     $this mappedForwardSet [List new]
  554.     $this sectNameSet [List new]
  555.     # Start constructor user section
  556.     if {[$this isSynthetic]} {
  557.     return $this
  558.     }
  559.     $this sections [FTSectionList new]
  560.     # End constructor user section
  561.     return $this
  562. }
  563.  
  564. method FTClass::destructor {this} {
  565.     # Start destructor user section
  566.     # End destructor user section
  567.     $this FTDefinition::destructor
  568. }
  569.  
  570. method FTClass::addInclude {this name} {
  571.     # don't add if 1) name=="" 2) name==$this.systemName 3) already present
  572.     #
  573.     if {$name == "" || $name == [$this systemName]} {
  574.     return
  575.     }
  576.     if {[[$this includeSet] search -exact $name] == -1} {
  577.     [$this includeSet] append $name
  578.     }
  579. }
  580.  
  581. method FTClass::addForward {this name {isMapped 0}} {
  582.     # don't add if 1) name=="" 2) name==$this.name 3) already present
  583.     #
  584.     if {$name == "" || $name == [$this name]} {
  585.     return
  586.     }
  587.     set pre "f"
  588.     if {$isMapped} {
  589.     set pre "mappedF"
  590.     }
  591.     if {[[$this ${pre}orwardSet] search -exact $name] == -1} {
  592.     [$this ${pre}orwardSet] append $name
  593.     }
  594. }
  595.  
  596. method FTClass::getGenSect {this {forWhat "DEF"}} {
  597.     # forWhat equals "DEF" (default) or "DECL"
  598.     #
  599.     set sect [TextSection new]
  600.  
  601.     if {$forWhat == "DECL" && [[$this sectNameSet] search -glob __*__] == -1} {
  602.     $sect append "-- empty\n"
  603.     return $sect
  604.     }
  605.  
  606.     set pre ""
  607.     if {[$this kind] != "CLASS"} {
  608.     set pre "-- "
  609.     }
  610.     $sect append "${pre}begin [$this kind];\n\n"
  611.  
  612.     $sect append "-- generated by ObjectTeam Forte code generator\n\n"
  613.  
  614.     $sect append "-- START PROJECT INCLUDES\n"
  615.     [$this includeSet] foreach incl {
  616.     $sect append "-- includes $incl;\n"
  617.     }
  618.     $sect append "-- END PROJECT INCLUDES\n\n"
  619.  
  620.     $sect append "-- START FORWARD CLASS DECLARATIONS\n"
  621.     [$this forwardSet] foreach fwd {
  622.     $sect append "forward $fwd;\n"
  623.     }
  624.     [$this mappedForwardSet] foreach fwd {
  625.     $sect append "forward $fwd is mapped;\n"
  626.     }
  627.     $sect append "-- END FORWARD CLASS DECLARATIONS\n\n"
  628.  
  629.     set doSkip 0
  630.     [$this sectNameSet] foreach sectName {
  631.     if {[string match __*__ $sectName]} {
  632.         if {$sectName == "__END__"} {
  633.         set doSkip 0
  634.         } elseif {$sectName == "__${forWhat}_ONLY__"} {
  635.         set doSkip 0
  636.         } else {
  637.         set doSkip 1
  638.         }
  639.         continue
  640.     }
  641.     if {$doSkip} {
  642.         continue
  643.     }
  644.  
  645.     if {$sectName == "map" && ![$this isMapped]} {
  646.         # poss. result of regeneration, when class UserWindow -> Object
  647.         continue
  648.     }
  649.  
  650.     set genSect [[$this sections] getSection $sectName]
  651.     if {[$genSect contents] != ""} {
  652.         if {$sectName == "obsolete"} {
  653.         $sect append "/* ${FTConstants::obsoleteCode} *\n"
  654.         $sect appendSect $genSect
  655.         $sect append " * ${FTConstants::obsoleteCode} */\n"
  656.         } else {
  657.         $sect appendSect $genSect
  658.         }
  659.         $sect append "\n"
  660.     }
  661.     }
  662.  
  663.     $sect append "${pre}end [$this kind];\n"
  664.  
  665.     return $sect
  666. }
  667.  
  668. method FTClass::findMethods {this name {kind ""}} {
  669.     # return a list of methods having 'name'
  670.     # 'kind' means a normal method by default, may also be 'event' (meaning
  671.     #  an event handler)
  672.     # to be used during regeneration
  673.     #
  674.     set meths {}
  675.     [$this methSet] foreach meth {
  676.     if {[$meth name] == $name} {
  677.         if {$kind == "event"} {
  678.         if {[$meth isA FTEventHandler]} {
  679.             lappend meths $meth
  680.         }
  681.         } else {
  682.         lappend meths $meth
  683.         }
  684.     }
  685.     }
  686.     return $meths
  687. }
  688.  
  689. method FTClass::findMethodsX {this name kind} {
  690.     # return list of list { meth {{par1 par2 ...} {type}} }
  691.     # to be used during regeneration
  692.     #
  693.     set lst {}
  694.     foreach meth [$this findMethods $name $kind] {
  695.     lappend lst [list $meth [$meth getSignature]]
  696.     }
  697.     return $lst
  698. }
  699.  
  700. # Do not delete this line -- regeneration end marker
  701.  
  702. method FTClass::attrSet {this} {
  703.     return [$this _attrSet]
  704. }
  705.  
  706. method FTClass::addAttr {this newAttr} {
  707.     [$this _attrSet] append $newAttr
  708.     $newAttr _theClass $this
  709. }
  710.  
  711. method FTClass::removeAttr {this oldAttr} {
  712.     $oldAttr _theClass ""
  713.     [$this _attrSet] removeValue $oldAttr
  714. }
  715.  
  716. method FTClass::methSet {this} {
  717.     return [$this _methSet]
  718. }
  719.  
  720. method FTClass::addMeth {this newMeth} {
  721.     [$this _methSet] append $newMeth
  722.     $newMeth _theClass $this
  723. }
  724.  
  725. method FTClass::removeMeth {this oldMeth} {
  726.     $oldMeth _theClass ""
  727.     [$this _methSet] removeValue $oldMeth
  728. }
  729.  
  730. method FTClass::addSectName {this newSectName} {
  731.     [$this sectNameSet] append $newSectName
  732.  
  733. }
  734.  
  735. method FTClass::removeSectName {this oldSectName} {
  736.     [$this sectNameSet] removeValue $oldSectName
  737. }
  738.  
  739. #---------------------------------------------------------------------------
  740. #      File:           @(#)ftserviceo.tcl    /main/hindenburg/4
  741. #---------------------------------------------------------------------------
  742.  
  743. # Start user added include file section
  744. # End user added include file section
  745.  
  746.  
  747. Class FTServiceObject : {FTClass} {
  748.     constructor
  749.     method destructor
  750.     method generate
  751. }
  752.  
  753. constructor FTServiceObject {class this i_name model i_systemName i_isSynthetic} {
  754.     set this [FTClass::constructor $class $this $i_name $model $i_systemName $i_isSynthetic]
  755.     # Start constructor user section
  756.     $this kind SERVICE
  757.     if {[$this isSynthetic]} {
  758.     return $this
  759.     }
  760.     [$this sectNameSet] contents {
  761.     service
  762.     }
  763.     [$this sections] addSects [[$this sectNameSet] contents]
  764.     # End constructor user section
  765.     return $this
  766. }
  767.  
  768. method FTServiceObject::destructor {this} {
  769.     # Start destructor user section
  770.     # End destructor user section
  771.     $this FTClass::destructor
  772. }
  773.  
  774. method FTServiceObject::generate {this} {
  775.     [$this methSet] foreach meth {
  776.     $meth generate
  777.     }
  778. }
  779.  
  780. # Do not delete this line -- regeneration end marker
  781.  
  782. #---------------------------------------------------------------------------
  783. #      File:           @(#)ftfeature.tcl    /main/hindenburg/1
  784. #---------------------------------------------------------------------------
  785.  
  786. # Start user added include file section
  787. # End user added include file section
  788.  
  789.  
  790. Class FTFeature : {FTObject} {
  791.     constructor
  792.     method destructor
  793.     attribute type
  794. }
  795.  
  796. constructor FTFeature {class this i_name type} {
  797.     set this [FTObject::constructor $class $this $i_name]
  798.     $this type $type
  799.     # Start constructor user section
  800.     # End constructor user section
  801.     return $this
  802. }
  803.  
  804. method FTFeature::destructor {this} {
  805.     # Start destructor user section
  806.     # End destructor user section
  807.     $this FTObject::destructor
  808. }
  809.  
  810. # Do not delete this line -- regeneration end marker
  811.  
  812. #---------------------------------------------------------------------------
  813. #      File:           @(#)ftmethod.tcl    /main/hindenburg/4
  814. #---------------------------------------------------------------------------
  815.  
  816. # Start user added include file section
  817. # End user added include file section
  818.  
  819.  
  820. Class FTMethod : {FTFeature} {
  821.     constructor
  822.     method destructor
  823.     method genAccess
  824.     method genSignature
  825.     method getSignature
  826.     method getUserCode
  827.     method theClass
  828.     method paramSet
  829.     method addParam
  830.     method removeParam
  831.     attribute hasCopyType
  832.     attribute isGenerated
  833.     attribute hasOldCode
  834.     attribute access
  835.     attribute _theClass
  836.     attribute _paramSet
  837.     attribute userCode
  838. }
  839.  
  840. constructor FTMethod {class this i_name type access theClass} {
  841.     set this [FTFeature::constructor $class $this $i_name $type]
  842.     $this hasCopyType 0
  843.     $this isGenerated 0
  844.     $this hasOldCode 0
  845.     $this access $access
  846.     $this _theClass $theClass
  847.     [$theClass _methSet] append $this
  848.     $this _paramSet [List new]
  849.     # Start constructor user section
  850.     # End constructor user section
  851.     return $this
  852. }
  853.  
  854. method FTMethod::destructor {this} {
  855.     # Start destructor user section
  856.     # End destructor user section
  857.     $this FTFeature::destructor
  858. }
  859.  
  860. method FTMethod::genAccess {this sect} {
  861.     $sect append "has "
  862.     # IMPR: FTMethod::genAccess: handle default prop
  863.     if {[$this access] == "private"} {
  864.     $sect append "private "
  865.     } else {
  866.     $sect append "public  "
  867.     }
  868. }
  869.  
  870. method FTMethod::genSignature {this sect {needsParen 0}} {
  871.     # generate signature for use during generation
  872.     # it is used for both the declaration and definition of the method
  873.     # signature is composed of name, parameters (or optional parentheses), and
  874.     #   return type
  875.     # it is formatted in the Forte cex layout
  876.     #
  877.     $sect append [$this name]
  878.  
  879.     # parameter list
  880.     #
  881.     if {[[$this paramSet] length] > 0 || $needsParen} {
  882.     $sect append "("
  883.     set pre ""
  884.     [$this paramSet] foreach param {
  885.         $param generate $pre $sect [$this theClass]
  886.         set pre ",\n\t"
  887.     }
  888.     $sect append ")"
  889.     }
  890.  
  891.     # return type (maybe a copy)
  892.     #
  893.     if {[$this type] != ""} {
  894.     $sect append ": "
  895.     if {[$this hasCopyType] && [[$this type] isClassType]} {
  896.         $sect append "copy "
  897.     }
  898.     # $sect append "[[$this type] getTypeName [$this theClass]]"
  899.     [$this type] generate "" $sect [$this theClass]
  900.     }
  901. }
  902.  
  903. method FTMethod::getSignature {this} {
  904.     # return the signature to be used during regeneration
  905.     # signature equals list { {par1 par2 ...} {type} }
  906.     #
  907.     set paramList {}
  908.     [$this paramSet] foreach param {
  909.     lappend paramList [[$param type] getTypeName [$this theClass]]
  910.     }
  911.  
  912.     set type ""
  913.     if {[$this type] != ""} {
  914.     set type [[$this type] getTypeName [$this theClass]]
  915.     }
  916.     return [list $paramList $type]
  917. }
  918.  
  919. method FTMethod::getUserCode {this} {
  920.     if {[$this userCode] == ""} {
  921.     $this userCode [TextSection new]
  922.     }
  923.     return [$this userCode]
  924. }
  925.  
  926. # Do not delete this line -- regeneration end marker
  927.  
  928. method FTMethod::theClass {this args} {
  929.     if {$args == ""} {
  930.         return [$this _theClass]
  931.     }
  932.     set ref [$this _theClass]
  933.     if {$ref != ""} {
  934.         [$ref _methSet] removeValue $this
  935.     }
  936.     set obj [lindex $args 0]
  937.     if {$obj != ""} {
  938.         [$obj _methSet] append $this
  939.     }
  940.     $this _theClass $obj
  941. }
  942.  
  943. method FTMethod::paramSet {this} {
  944.     return [$this _paramSet]
  945. }
  946.  
  947. method FTMethod::addParam {this newParam} {
  948.     [$this _paramSet] append $newParam
  949.     $newParam _method $this
  950. }
  951.  
  952. method FTMethod::removeParam {this oldParam} {
  953.     $oldParam _method ""
  954.     [$this _paramSet] removeValue $oldParam
  955. }
  956.  
  957. #---------------------------------------------------------------------------
  958. #      File:           @(#)ftcursorde.tcl    /main/hindenburg/2
  959. #---------------------------------------------------------------------------
  960.  
  961. # Start user added include file section
  962. # End user added include file section
  963.  
  964.  
  965. Class FTCursorDef : {FTMethod} {
  966.     constructor
  967.     method destructor
  968.     method generate
  969. }
  970.  
  971. constructor FTCursorDef {class this i_name type access theClass} {
  972.     set this [FTMethod::constructor $class $this $i_name $type $access $theClass]
  973.     # Start constructor user section
  974.     # End constructor user section
  975.     return $this
  976. }
  977.  
  978. method FTCursorDef::destructor {this} {
  979.     # Start destructor user section
  980.     # End destructor user section
  981.     $this FTMethod::destructor
  982. }
  983.  
  984. method FTCursorDef::generate {this} {
  985.     set sect [[[$this theClass] sections] getSection cursorDef]
  986.  
  987.     set signSect [TextSection new]
  988.     $this genSignature $signSect
  989.  
  990.     $sect append "cursor "
  991.     $sect appendSect $signSect
  992.     $sect append "\nbegin\n"
  993.     if {[$this userCode] != ""} {
  994.     $sect pushIndent 1
  995.     $sect appendSect [$this userCode]
  996.     $sect popIndent
  997.     } else {
  998.     $sect indent +
  999.     $sect append "-- !! Implement this cursor !!\n"
  1000.     $sect indent -
  1001.     }
  1002.     $sect append "end;\n\n"
  1003. }
  1004.  
  1005. # Do not delete this line -- regeneration end marker
  1006.  
  1007. #---------------------------------------------------------------------------
  1008. #      File:           @(#)ftcomposit.tcl    /main/hindenburg/2
  1009. #---------------------------------------------------------------------------
  1010.  
  1011. # Start user added include file section
  1012. # End user added include file section
  1013.  
  1014.  
  1015. Class FTComposite : {FTClass} {
  1016.     constructor
  1017.     method destructor
  1018.     method generate
  1019.     method getKind
  1020.     method itemSet
  1021.     method addItem
  1022.     method removeItem
  1023.     attribute _itemSet
  1024. }
  1025.  
  1026. constructor FTComposite {class this i_name model i_systemName i_isSynthetic} {
  1027.     set this [FTClass::constructor $class $this $i_name $model $i_systemName $i_isSynthetic]
  1028.     $this _itemSet [List new]
  1029.     # Start constructor user section
  1030.     if {[$this isSynthetic]} {
  1031.     return $this
  1032.     }
  1033.     [$this sectNameSet] contents {
  1034.     composite
  1035.     }
  1036.     [$this sections] addSects [[$this sectNameSet] contents]
  1037.     # End constructor user section
  1038.     return $this
  1039. }
  1040.  
  1041. method FTComposite::destructor {this} {
  1042.     # Start destructor user section
  1043.     # End destructor user section
  1044.     $this FTClass::destructor
  1045. }
  1046.  
  1047. method FTComposite::generate {this} {
  1048.     if {[$this isSynthetic]} {
  1049.     return
  1050.     }
  1051.     
  1052.     set sect [[$this sections] getSection composite]
  1053.     $sect append "[$this getKind] [$this name]\n"
  1054.     $sect indent +
  1055.     [$this itemSet] foreach item {
  1056.     $item generate $sect
  1057.     }
  1058.     $sect indent -
  1059.     $sect append "\nend [$this getKind];\n"
  1060. }
  1061.  
  1062. method FTComposite::getKind {this} {
  1063.     return ""
  1064. }
  1065.  
  1066. # Do not delete this line -- regeneration end marker
  1067.  
  1068. method FTComposite::itemSet {this} {
  1069.     return [$this _itemSet]
  1070. }
  1071.  
  1072. method FTComposite::addItem {this newItem} {
  1073.     [$this _itemSet] append $newItem
  1074.     $newItem _composite $this
  1075. }
  1076.  
  1077. method FTComposite::removeItem {this oldItem} {
  1078.     $oldItem _composite ""
  1079.     [$this _itemSet] removeValue $oldItem
  1080. }
  1081.  
  1082. #---------------------------------------------------------------------------
  1083. #      File:           @(#)ftattribut.tcl    /main/hindenburg/2
  1084. #---------------------------------------------------------------------------
  1085.  
  1086. # Start user added include file section
  1087. # End user added include file section
  1088.  
  1089.  
  1090. Class FTAttribute : {FTFeature} {
  1091.     constructor
  1092.     method destructor
  1093.     method genAccess
  1094.     method theClass
  1095.     attribute access
  1096.     attribute _theClass
  1097. }
  1098.  
  1099. constructor FTAttribute {class this i_name type access theClass} {
  1100.     set this [FTFeature::constructor $class $this $i_name $type]
  1101.     $this access $access
  1102.     $this _theClass $theClass
  1103.     [$theClass _attrSet] append $this
  1104.     # Start constructor user section
  1105.     # End constructor user section
  1106.     return $this
  1107. }
  1108.  
  1109. method FTAttribute::destructor {this} {
  1110.     # Start destructor user section
  1111.     # End destructor user section
  1112.     $this FTFeature::destructor
  1113. }
  1114.  
  1115. method FTAttribute::genAccess {this sect} {
  1116.     $sect append "has "
  1117.     if {[$this access] == "private"} {
  1118.     $sect append "private "
  1119.     } else {
  1120.     $sect append "public  "
  1121.     }
  1122. }
  1123.  
  1124. # Do not delete this line -- regeneration end marker
  1125.  
  1126. method FTAttribute::theClass {this args} {
  1127.     if {$args == ""} {
  1128.         return [$this _theClass]
  1129.     }
  1130.     set ref [$this _theClass]
  1131.     if {$ref != ""} {
  1132.         [$ref _attrSet] removeValue $this
  1133.     }
  1134.     set obj [lindex $args 0]
  1135.     if {$obj != ""} {
  1136.         [$obj _attrSet] append $this
  1137.     }
  1138.     $this _theClass $obj
  1139. }
  1140.  
  1141. #---------------------------------------------------------------------------
  1142. #      File:           @(#)ftcmnmetho.tcl    /main/hindenburg/6
  1143. #---------------------------------------------------------------------------
  1144.  
  1145. # Start user added include file section
  1146. # End user added include file section
  1147.  
  1148.  
  1149. Class FTCmnMethod : {FTMethod} {
  1150.     constructor
  1151.     method destructor
  1152.     method generate
  1153.     method subGenerate
  1154.     attribute returnEvent
  1155.     attribute exceptEvent
  1156. }
  1157.  
  1158. constructor FTCmnMethod {class this i_name type access theClass} {
  1159.     set this [FTMethod::constructor $class $this $i_name $type $access $theClass]
  1160.     # Start constructor user section
  1161.     # End constructor user section
  1162.     return $this
  1163. }
  1164.  
  1165. method FTCmnMethod::destructor {this} {
  1166.     # Start destructor user section
  1167.     # End destructor user section
  1168.     $this FTMethod::destructor
  1169. }
  1170.  
  1171. method FTCmnMethod::generate {this} {
  1172.     set decSect [[[$this theClass] sections] getSection method]
  1173.     $this genAccess $decSect
  1174.     $decSect append "method "
  1175.  
  1176.     set signSect [TextSection new]
  1177.     $this genSignature $signSect
  1178.  
  1179.     $decSect appendSect $signSect
  1180.  
  1181.     if {[$this returnEvent] != ""} {
  1182.     $decSect append " where completion = (return = [$this returnEvent]"
  1183.     }
  1184.     if {[$this exceptEvent] != ""} {
  1185.     if {[$this returnEvent] == ""} {
  1186.         $decSect append " where completion = ("
  1187.     } else {
  1188.         $decSect append ", "
  1189.     }
  1190.     $decSect append "exception = [$this exceptEvent]"
  1191.     }
  1192.     if {[$this returnEvent] != "" || [$this exceptEvent] != ""} {
  1193.     $decSect append ")"
  1194.     }
  1195.  
  1196.     $decSect append ";\n"
  1197.  
  1198.     set defSect [[[$this theClass] sections] getSection methodDef]
  1199.     $defSect append "method [[$this theClass] name]."
  1200.     $defSect appendSect $signSect
  1201.     $defSect append "\nbegin\n"
  1202.     $defSect indent +
  1203.     $this subGenerate $defSect
  1204.     $defSect indent -
  1205.     $defSect append "end method;\n\n"
  1206. }
  1207.  
  1208. method FTCmnMethod::subGenerate {this sect} {
  1209.     if {[$this userCode] != ""} {
  1210.     $sect pushIndent 1
  1211.     if {[$this hasOldCode]} {
  1212.         $sect append "/* ${FTConstants::oldCode} *\n"
  1213.         $sect appendSect [$this userCode]
  1214.         $sect append " * ${FTConstants::oldCode} */\n"
  1215.     } else {
  1216.         $sect appendSect [$this userCode]
  1217.         $sect popIndent
  1218.         return
  1219.     }
  1220.     $sect popIndent
  1221.     }
  1222.     $sect append "-- !! Implement this method !!\n"
  1223. }
  1224.  
  1225. # Do not delete this line -- regeneration end marker
  1226.  
  1227. #---------------------------------------------------------------------------
  1228. #      File:           @(#)ftgenmetho.tcl    /main/hindenburg/2
  1229. #---------------------------------------------------------------------------
  1230.  
  1231. # Start user added include file section
  1232. # End user added include file section
  1233.  
  1234.  
  1235. Class FTGenMethod : {FTCmnMethod} {
  1236.     constructor
  1237.     method destructor
  1238.     method subGenerate
  1239.     attribute genCode
  1240. }
  1241.  
  1242. constructor FTGenMethod {class this i_name type access theClass} {
  1243.     set this [FTCmnMethod::constructor $class $this $i_name $type $access $theClass]
  1244.     # Start constructor user section
  1245.     $this genCode [TextSection new]
  1246.     # End constructor user section
  1247.     return $this
  1248. }
  1249.  
  1250. method FTGenMethod::destructor {this} {
  1251.     # Start destructor user section
  1252.     # End destructor user section
  1253.     $this FTCmnMethod::destructor
  1254. }
  1255.  
  1256. method FTGenMethod::subGenerate {this sect} {
  1257.     $sect appendSect [$this genCode]
  1258. }
  1259.  
  1260. # Do not delete this line -- regeneration end marker
  1261.  
  1262. #---------------------------------------------------------------------------
  1263. #      File:           @(#)ftaccmetho.tcl    /main/hindenburg/2
  1264. #---------------------------------------------------------------------------
  1265.  
  1266. # Start user added include file section
  1267. # End user added include file section
  1268.  
  1269.  
  1270. Class FTAccMethod : {FTGenMethod} {
  1271.     constructor
  1272.     method destructor
  1273.     attribute belongsTo
  1274. }
  1275.  
  1276. constructor FTAccMethod {class this i_name type access theClass belongsTo} {
  1277.     set this [FTGenMethod::constructor $class $this $i_name $type $access $theClass]
  1278.     $this belongsTo $belongsTo
  1279.     # Start constructor user section
  1280.     $this isGenerated 1
  1281.     # End constructor user section
  1282.     return $this
  1283. }
  1284.  
  1285. method FTAccMethod::destructor {this} {
  1286.     # Start destructor user section
  1287.     # End destructor user section
  1288.     $this FTGenMethod::destructor
  1289. }
  1290.  
  1291. # Do not delete this line -- regeneration end marker
  1292.  
  1293. #---------------------------------------------------------------------------
  1294. #      File:           @(#)ftcmnclass.tcl    /main/hindenburg/5
  1295. #---------------------------------------------------------------------------
  1296.  
  1297. # Start user added include file section
  1298. # End user added include file section
  1299.  
  1300.  
  1301. Class FTCmnClass : {FTClass} {
  1302.     constructor
  1303.     method destructor
  1304.     method generate
  1305.     attribute constructor
  1306. }
  1307.  
  1308. constructor FTCmnClass {class this i_name model i_systemName i_isSynthetic} {
  1309.     set this [FTClass::constructor $class $this $i_name $model $i_systemName $i_isSynthetic]
  1310.     # Start constructor user section
  1311.     if {[$this isSynthetic]} {
  1312.     return $this
  1313.     }
  1314.     [$this sectNameSet] contents {
  1315.     header 
  1316.     constant
  1317.     attribute
  1318.     virtualAttribute
  1319.     event
  1320.     method
  1321.     eventHandler
  1322.     property
  1323.     map
  1324.     trailer
  1325.     __DEF_ONLY__
  1326.     methodDef
  1327.     eventHandlerDef
  1328.     obsolete
  1329.     }
  1330.     [$this sections] addSects [[$this sectNameSet] contents]
  1331.     # End constructor user section
  1332.     return $this
  1333. }
  1334.  
  1335. method FTCmnClass::destructor {this} {
  1336.     # Start destructor user section
  1337.     # End destructor user section
  1338.     $this FTClass::destructor
  1339. }
  1340.  
  1341. method FTCmnClass::generate {this} {
  1342.     if {[$this isSynthetic]} {
  1343.     return
  1344.     }
  1345.     
  1346.     set sect [[$this sections] getSection header]
  1347.     $sect append "class [$this name] "
  1348.     if {[$this isMapped]} {
  1349.     $sect append "is mapped "
  1350.     }
  1351.     $sect append "inherits from [[$this super] getTypeName $this]\n"
  1352.  
  1353.     [$this attrSet] foreach attr {
  1354.     $attr generate
  1355.     }
  1356.     [$this methSet] foreach meth {
  1357.     $meth generate
  1358.     }
  1359.  
  1360.     if {[$this isMapped]} {
  1361.     $this generateMap
  1362.     }
  1363.  
  1364.     set sect [[$this sections] getSection trailer]
  1365.     $sect append "end class;\n"
  1366. }
  1367.  
  1368. # Do not delete this line -- regeneration end marker
  1369.  
  1370. #---------------------------------------------------------------------------
  1371. #      File:           @(#)ftwinclass.tcl    /main/hindenburg/3
  1372. #---------------------------------------------------------------------------
  1373.  
  1374. # Start user added include file section
  1375. # End user added include file section
  1376.  
  1377.  
  1378. Class FTWinClass : {FTCmnClass} {
  1379.     constructor
  1380.     method destructor
  1381.     method generateMap
  1382. }
  1383.  
  1384. constructor FTWinClass {class this i_name model i_systemName i_isSynthetic} {
  1385.     set this [FTCmnClass::constructor $class $this $i_name $model $i_systemName $i_isSynthetic]
  1386.     # Start constructor user section
  1387.     $this isMapped 1
  1388.     # End constructor user section
  1389.     return $this
  1390. }
  1391.  
  1392. method FTWinClass::destructor {this} {
  1393.     # Start destructor user section
  1394.     # End destructor user section
  1395.     $this FTCmnClass::destructor
  1396. }
  1397.  
  1398. method FTWinClass::generateMap {this} {
  1399.     set sect [[$this sections] getSection map]
  1400.     if {[$sect contents] != ""} {
  1401.     # regenerated...
  1402.     return
  1403.     }
  1404.  
  1405.     $sect append "has\n"
  1406.     $sect append "+5151463100000111000000ec9fe4010100002101020000000002020600940800\n"
  1407.     $sect append "+1d009fff010104210f1011120101011700009fff000000000900000bb80fa000\n"
  1408.     $sect append "+000000000000000000010160600000000000000000009d0bb89d0fa000000105\n"
  1409.     $sect append "+030301fffd0000000000000c0405000600000201000100000b000001000b0300\n"
  1410.     $sect append "+0021010200000000050400001c01000506007a08004d009fff010101010f1011\n"
  1411.     $sect append "+120101011700009fff0100000009000007d007d0000000000303030300020202\n"
  1412.     $sect append "+a0a00000000000000000009d07d09d07d000000105066b010000000000000000\n"
  1413.     $sect append "+060006000021000200000000061a7e898f9ce29cec12191a385e5f6b7e88898d\n"
  1414.     $sect append "+8f9cad9cd39cd49ce09ce29cec9cec0000\n"
  1415.     $sect append "-001e986b\n"
  1416. }
  1417.  
  1418. # Do not delete this line -- regeneration end marker
  1419.  
  1420. #---------------------------------------------------------------------------
  1421. #      File:           @(#)fteventhan.tcl    /main/hindenburg/2
  1422. #---------------------------------------------------------------------------
  1423.  
  1424. # Start user added include file section
  1425. # End user added include file section
  1426.  
  1427.  
  1428. Class FTEventHandler : {FTMethod} {
  1429.     constructor
  1430.     method destructor
  1431.     method generate
  1432. }
  1433.  
  1434. constructor FTEventHandler {class this i_name type access theClass} {
  1435.     set this [FTMethod::constructor $class $this $i_name $type $access $theClass]
  1436.     # Start constructor user section
  1437.     # End constructor user section
  1438.     return $this
  1439. }
  1440.  
  1441. method FTEventHandler::destructor {this} {
  1442.     # Start destructor user section
  1443.     # End destructor user section
  1444.     $this FTMethod::destructor
  1445. }
  1446.  
  1447. method FTEventHandler::generate {this} {
  1448.     set decSect [[[$this theClass] sections] getSection eventHandler]
  1449.     $this genAccess $decSect
  1450.     $decSect append "event handler "
  1451.  
  1452.     set signSect [TextSection new]
  1453.     $this genSignature $signSect 1
  1454.  
  1455.     $decSect appendSect $signSect
  1456.     $decSect append ";\n"
  1457.  
  1458.     set defSect [[[$this theClass] sections] getSection eventHandlerDef]
  1459.     $defSect append "event handler [[$this theClass] name]."
  1460.     $defSect appendSect $signSect
  1461.     $defSect append "\nbegin\n"
  1462.     if {[$this userCode] != ""} {
  1463.     $defSect pushIndent 1
  1464.     if {[$this hasOldCode]} {
  1465.         $defSect append "/* ${FTConstants::oldCode} *\n"
  1466.         $defSect appendSect [$this userCode]
  1467.         $defSect append " * ${FTConstants::oldCode} */\n"
  1468.     } else {
  1469.         $defSect appendSect [$this userCode]
  1470.     }
  1471.     $defSect popIndent
  1472.     }
  1473.     if {[$this userCode] == "" || [$this hasOldCode]} {
  1474.     $defSect indent +
  1475.     $defSect append "-- !! Implement this event handler !!\n"
  1476.     $defSect indent -
  1477.     }
  1478.     $defSect append "end event;\n\n"
  1479. }
  1480.  
  1481. # Do not delete this line -- regeneration end marker
  1482.  
  1483. #---------------------------------------------------------------------------
  1484. #      File:           @(#)ftconstant.tcl    /main/hindenburg/3
  1485. #---------------------------------------------------------------------------
  1486.  
  1487. # Start user added include file section
  1488. # End user added include file section
  1489.  
  1490.  
  1491. Class FTConstant : {FTClass} {
  1492.     constructor
  1493.     method destructor
  1494.     method generate
  1495.     attribute value
  1496. }
  1497.  
  1498. constructor FTConstant {class this i_name model i_systemName i_isSynthetic i_value} {
  1499.     set this [FTClass::constructor $class $this $i_name $model $i_systemName $i_isSynthetic]
  1500.     $this value $i_value
  1501.     # Start constructor user section
  1502.     $this kind CONSTANT
  1503.     if {[$this isSynthetic]} {
  1504.     return $this
  1505.     }
  1506.     [$this sectNameSet] contents {
  1507.     constant
  1508.     }
  1509.     [$this sections] addSects [[$this sectNameSet] contents]
  1510.     # End constructor user section
  1511.     return $this
  1512. }
  1513.  
  1514. method FTConstant::destructor {this} {
  1515.     # Start destructor user section
  1516.     # End destructor user section
  1517.     $this FTClass::destructor
  1518. }
  1519.  
  1520. method FTConstant::generate {this} {
  1521.     set sect [[$this sections] getSection constant]
  1522.     $sect append "constant [$this name] = [$this value];\n"
  1523. }
  1524.  
  1525. # Do not delete this line -- regeneration end marker
  1526.  
  1527. #---------------------------------------------------------------------------
  1528. #      File:           @(#)ftcursor.tcl    /main/hindenburg/3
  1529. #---------------------------------------------------------------------------
  1530.  
  1531. # Start user added include file section
  1532. # End user added include file section
  1533.  
  1534.  
  1535. Class FTCursor : {FTClass} {
  1536.     constructor
  1537.     method destructor
  1538.     method generate
  1539. }
  1540.  
  1541. constructor FTCursor {class this i_name model i_systemName i_isSynthetic} {
  1542.     set this [FTClass::constructor $class $this $i_name $model $i_systemName $i_isSynthetic]
  1543.     # Start constructor user section
  1544.     $this kind CURSOR
  1545.     if {[$this isSynthetic]} {
  1546.     return $this
  1547.     }
  1548.     [$this sectNameSet] contents {
  1549.     cursorDef
  1550.     }
  1551.     [$this sections] addSects [[$this sectNameSet] contents]
  1552.     # End constructor user section
  1553.     return $this
  1554. }
  1555.  
  1556. method FTCursor::destructor {this} {
  1557.     # Start destructor user section
  1558.     # End destructor user section
  1559.     $this FTClass::destructor
  1560. }
  1561.  
  1562. method FTCursor::generate {this} {
  1563.     [$this methSet] foreach meth {
  1564.     $meth generate
  1565.     }
  1566. }
  1567.  
  1568. # Do not delete this line -- regeneration end marker
  1569.  
  1570. #---------------------------------------------------------------------------
  1571. #      File:           @(#)ftevent.tcl    /main/hindenburg/1
  1572. #---------------------------------------------------------------------------
  1573.  
  1574. # Start user added include file section
  1575. # End user added include file section
  1576.  
  1577.  
  1578. Class FTEvent : {FTMethod} {
  1579.     constructor
  1580.     method destructor
  1581.     method generate
  1582. }
  1583.  
  1584. constructor FTEvent {class this i_name type access theClass} {
  1585.     set this [FTMethod::constructor $class $this $i_name $type $access $theClass]
  1586.     # Start constructor user section
  1587.     # End constructor user section
  1588.     return $this
  1589. }
  1590.  
  1591. method FTEvent::destructor {this} {
  1592.     # Start destructor user section
  1593.     # End destructor user section
  1594.     $this FTMethod::destructor
  1595. }
  1596.  
  1597. method FTEvent::generate {this} {
  1598.     set sect [[[$this theClass] sections] getSection event]
  1599.     $this genAccess $sect
  1600.     $sect append "event "
  1601.     $this genSignature $sect
  1602.     $sect append ";\n"
  1603. }
  1604.  
  1605. # Do not delete this line -- regeneration end marker
  1606.  
  1607. #---------------------------------------------------------------------------
  1608. #      File:           @(#)ftunion.tcl    /main/hindenburg/2
  1609. #---------------------------------------------------------------------------
  1610.  
  1611. # Start user added include file section
  1612. # End user added include file section
  1613.  
  1614.  
  1615. Class FTUnion : {FTComposite} {
  1616.     constructor
  1617.     method destructor
  1618.     method getKind
  1619. }
  1620.  
  1621. constructor FTUnion {class this i_name model i_systemName i_isSynthetic} {
  1622.     set this [FTComposite::constructor $class $this $i_name $model $i_systemName $i_isSynthetic]
  1623.     # Start constructor user section
  1624.     $this kind UNION
  1625.     # End constructor user section
  1626.     return $this
  1627. }
  1628.  
  1629. method FTUnion::destructor {this} {
  1630.     # Start destructor user section
  1631.     # End destructor user section
  1632.     $this FTComposite::destructor
  1633. }
  1634.  
  1635. method FTUnion::getKind {this} {
  1636.     return union
  1637. }
  1638.  
  1639. # Do not delete this line -- regeneration end marker
  1640.  
  1641. #---------------------------------------------------------------------------
  1642. #      File:           @(#)ftconstatt.tcl    /main/hindenburg/3
  1643. #---------------------------------------------------------------------------
  1644.  
  1645. # Start user added include file section
  1646. # End user added include file section
  1647.  
  1648.  
  1649. Class FTConstAttrib : {FTAttribute} {
  1650.     constructor
  1651.     method destructor
  1652.     method generate
  1653.     attribute value
  1654. }
  1655.  
  1656. constructor FTConstAttrib {class this i_name type access theClass i_value} {
  1657.     set this [FTAttribute::constructor $class $this $i_name $type $access $theClass]
  1658.     $this value $i_value
  1659.     # Start constructor user section
  1660.     # End constructor user section
  1661.     return $this
  1662. }
  1663.  
  1664. method FTConstAttrib::destructor {this} {
  1665.     # Start destructor user section
  1666.     # End destructor user section
  1667.     $this FTAttribute::destructor
  1668. }
  1669.  
  1670. method FTConstAttrib::generate {this} {
  1671.     set sect [[[$this theClass] sections] getSection constant]
  1672.     $this genAccess $sect
  1673.     $sect append "constant [$this name] = "
  1674.     # IMPR: FTConstAttrib::generate: handle type, e.g. 0.0/0/'' 
  1675.     $sect append "[$this value];\n"
  1676. }
  1677.  
  1678. # Do not delete this line -- regeneration end marker
  1679.  
  1680. #---------------------------------------------------------------------------
  1681. #      File:           @(#)ftconstruc.tcl    /main/hindenburg/2
  1682. #---------------------------------------------------------------------------
  1683.  
  1684. # Start user added include file section
  1685. # End user added include file section
  1686.  
  1687.  
  1688. Class FTConstructor : {FTGenMethod} {
  1689.     constructor
  1690.     method destructor
  1691.     method generate
  1692. }
  1693.  
  1694. constructor FTConstructor {class this i_name type access theClass} {
  1695.     set this [FTGenMethod::constructor $class $this $i_name $type $access $theClass]
  1696.     # Start constructor user section
  1697.     # End constructor user section
  1698.     return $this
  1699. }
  1700.  
  1701. method FTConstructor::destructor {this} {
  1702.     # Start destructor user section
  1703.     # End destructor user section
  1704.     $this FTGenMethod::destructor
  1705. }
  1706.  
  1707. method FTConstructor::generate {this} {
  1708.     # empty
  1709. }
  1710.  
  1711. # Do not delete this line -- regeneration end marker
  1712.  
  1713. #---------------------------------------------------------------------------
  1714. #      File:           @(#)ftstruct.tcl    /main/hindenburg/2
  1715. #---------------------------------------------------------------------------
  1716.  
  1717. # Start user added include file section
  1718. # End user added include file section
  1719.  
  1720.  
  1721. Class FTStruct : {FTComposite} {
  1722.     constructor
  1723.     method destructor
  1724.     method getKind
  1725. }
  1726.  
  1727. constructor FTStruct {class this i_name model i_systemName i_isSynthetic} {
  1728.     set this [FTComposite::constructor $class $this $i_name $model $i_systemName $i_isSynthetic]
  1729.     # Start constructor user section
  1730.     $this kind STRUCT
  1731.     # End constructor user section
  1732.     return $this
  1733. }
  1734.  
  1735. method FTStruct::destructor {this} {
  1736.     # Start destructor user section
  1737.     # End destructor user section
  1738.     $this FTComposite::destructor
  1739. }
  1740.  
  1741. method FTStruct::getKind {this} {
  1742.     return struct
  1743. }
  1744.  
  1745. # Do not delete this line -- regeneration end marker
  1746.  
  1747. #---------------------------------------------------------------------------
  1748. #      File:           @(#)ftservice.tcl    /main/hindenburg/3
  1749. #---------------------------------------------------------------------------
  1750.  
  1751. # Start user added include file section
  1752. # End user added include file section
  1753.  
  1754.  
  1755. Class FTService : {FTMethod} {
  1756.     constructor
  1757.     method destructor
  1758.     method generate
  1759. }
  1760.  
  1761. constructor FTService {class this i_name type access theClass} {
  1762.     set this [FTMethod::constructor $class $this $i_name $type $access $theClass]
  1763.     # Start constructor user section
  1764.     # End constructor user section
  1765.     return $this
  1766. }
  1767.  
  1768. method FTService::destructor {this} {
  1769.     # Start destructor user section
  1770.     # End destructor user section
  1771.     $this FTMethod::destructor
  1772. }
  1773.  
  1774. method FTService::generate {this} {
  1775.     set sect [[[$this theClass] sections] getSection service]
  1776.  
  1777.     set name [[$this theClass] name]
  1778.     $sect append "service $name : "
  1779.  
  1780.     # following code has been taken from FTMethod::genSignature
  1781.     #
  1782.     # service type equals return type or else the name of this method
  1783.     # we do this to get a real 'type' (qualified with system) iso just a 'name'
  1784.     #
  1785.     if {[$this type] != ""} {
  1786.     set className [[$this type] getTypeName [$this theClass]]
  1787.     } else {
  1788.     set className [$this name]
  1789.     }
  1790.     $sect append $className
  1791.     m4_message $M_SERVICE_OBJ $className
  1792.  
  1793.     # parameter list
  1794.     #
  1795.     if {[[$this paramSet] length] > 0} {
  1796.     $sect append " = ("
  1797.     set pre ""
  1798.     [$this paramSet] foreach param {
  1799.         # parameters without default value (in terms of service objects:
  1800.         #  attributes without initial value) are skipped
  1801.         #
  1802.         if {[$param defaultVal] != ""} {
  1803.         $param generate $pre $sect [$this theClass]
  1804.         set pre ",\n\t"
  1805.         } else {
  1806.         m4_warning $W_SERVICE_OBJ3 [$param name] $name
  1807.         }
  1808.     }
  1809.     $sect append ")"
  1810.     }
  1811.  
  1812.     $sect append ";\n"
  1813. }
  1814.  
  1815. # Do not delete this line -- regeneration end marker
  1816.  
  1817. #---------------------------------------------------------------------------
  1818. #      File:           @(#)ftinit.tcl    /main/hindenburg/3
  1819. #---------------------------------------------------------------------------
  1820.  
  1821. # Start user added include file section
  1822. # End user added include file section
  1823.  
  1824.  
  1825. Class FTInit : {FTGenMethod} {
  1826.     constructor
  1827.     method destructor
  1828.     method subGenerate
  1829. }
  1830.  
  1831. constructor FTInit {class this i_name type access theClass} {
  1832.     set this [FTGenMethod::constructor $class $this $i_name $type $access $theClass]
  1833.     # Start constructor user section
  1834.     $this name Init
  1835.     $this access public
  1836.     # End constructor user section
  1837.     return $this
  1838. }
  1839.  
  1840. method FTInit::destructor {this} {
  1841.     # Start destructor user section
  1842.     # End destructor user section
  1843.     $this FTGenMethod::destructor
  1844. }
  1845.  
  1846. method FTInit::subGenerate {this sect} {
  1847.     $sect append "super.Init();\n"
  1848.     $sect appendSect [$this genCode]
  1849.     $sect append "-- ${FTConstants::startCtor}\n"
  1850.     if {[$this userCode] != ""} {
  1851.     $sect pushIndent 1
  1852.     $sect appendSect [$this userCode]
  1853.     $sect popIndent
  1854.     }
  1855.     $sect append "-- ${FTConstants::endCtor}\n"
  1856. }
  1857.  
  1858. # Do not delete this line -- regeneration end marker
  1859.  
  1860. #---------------------------------------------------------------------------
  1861. #      File:           @(#)ftusermeth.tcl    /main/hindenburg/1
  1862. #---------------------------------------------------------------------------
  1863.  
  1864. # Start user added include file section
  1865. # End user added include file section
  1866.  
  1867.  
  1868. Class FTUserMethod : {FTCmnMethod} {
  1869.     constructor
  1870.     method destructor
  1871. }
  1872.  
  1873. constructor FTUserMethod {class this i_name type access theClass} {
  1874.     set this [FTCmnMethod::constructor $class $this $i_name $type $access $theClass]
  1875.     # Start constructor user section
  1876.     # End constructor user section
  1877.     return $this
  1878. }
  1879.  
  1880. method FTUserMethod::destructor {this} {
  1881.     # Start destructor user section
  1882.     # End destructor user section
  1883.     $this FTCmnMethod::destructor
  1884. }
  1885.  
  1886. # Do not delete this line -- regeneration end marker
  1887.  
  1888. #---------------------------------------------------------------------------
  1889. #      File:           @(#)ftdisplay.tcl    /main/hindenburg/3
  1890. #---------------------------------------------------------------------------
  1891.  
  1892. # Start user added include file section
  1893. # End user added include file section
  1894.  
  1895.  
  1896. Class FTDisplay : {FTGenMethod} {
  1897.     constructor
  1898.     method destructor
  1899.     method subGenerate
  1900. }
  1901.  
  1902. constructor FTDisplay {class this i_name type access theClass} {
  1903.     set this [FTGenMethod::constructor $class $this $i_name $type $access $theClass]
  1904.     # Start constructor user section
  1905.     $this name Display
  1906.     $this access public
  1907.     # End constructor user section
  1908.     return $this
  1909. }
  1910.  
  1911. method FTDisplay::destructor {this} {
  1912.     # Start destructor user section
  1913.     # End destructor user section
  1914.     $this FTGenMethod::destructor
  1915. }
  1916.  
  1917. method FTDisplay::subGenerate {this sect} {
  1918.     if {[$this userCode] != ""} {
  1919.     $sect pushIndent 1
  1920.     $sect appendSect [$this userCode]
  1921.     $sect popIndent
  1922.     return
  1923.     }
  1924.  
  1925.     $sect append "self.Open();
  1926.     event loop
  1927.         when task.Shutdown do
  1928.         exit;
  1929.     end event;\n"
  1930.     $sect append "self.Close();\n"
  1931. }
  1932.  
  1933. # Do not delete this line -- regeneration end marker
  1934.  
  1935. #---------------------------------------------------------------------------
  1936. #      File:           @(#)ftvirtattr.tcl    /main/hindenburg/2
  1937. #---------------------------------------------------------------------------
  1938.  
  1939. # Start user added include file section
  1940. # End user added include file section
  1941.  
  1942.  
  1943. Class FTVirtAttrib : {FTAttribute} {
  1944.     constructor
  1945.     method destructor
  1946.     method generate
  1947.     attribute getExpr
  1948.     attribute setExpr
  1949. }
  1950.  
  1951. constructor FTVirtAttrib {class this i_name type access theClass i_getExpr} {
  1952.     set this [FTAttribute::constructor $class $this $i_name $type $access $theClass]
  1953.     $this getExpr $i_getExpr
  1954.     # Start constructor user section
  1955.     # End constructor user section
  1956.     return $this
  1957. }
  1958.  
  1959. method FTVirtAttrib::destructor {this} {
  1960.     # Start destructor user section
  1961.     # End destructor user section
  1962.     $this FTAttribute::destructor
  1963. }
  1964.  
  1965. method FTVirtAttrib::generate {this} {
  1966.     set sect [[[$this theClass] sections] getSection virtualAttribute]
  1967.     $this genAccess $sect
  1968.     $sect append "virtual attribute "
  1969.     [$this type] generate [$this name] $sect [$this theClass]
  1970.     $sect append " = (get =[$this getExpr]"
  1971.     if {[$this setExpr] != ""} {
  1972.     $sect append ", set =[$this setExpr]"
  1973.     }
  1974.     $sect append ");\n"
  1975. }
  1976.  
  1977. # Do not delete this line -- regeneration end marker
  1978.  
  1979. #---------------------------------------------------------------------------
  1980. #      File:           @(#)fttypedef.tcl    /main/hindenburg/3
  1981. #---------------------------------------------------------------------------
  1982.  
  1983. # Start user added include file section
  1984. # End user added include file section
  1985.  
  1986.  
  1987. Class FTTypeDef : {FTClass} {
  1988.     constructor
  1989.     method destructor
  1990.     method generate
  1991.     attribute type
  1992. }
  1993.  
  1994. constructor FTTypeDef {class this i_name model i_systemName i_isSynthetic type} {
  1995.     set this [FTClass::constructor $class $this $i_name $model $i_systemName $i_isSynthetic]
  1996.     $this type $type
  1997.     # Start constructor user section
  1998.     $this kind TYPEDEF
  1999.     if {[$this isSynthetic]} {
  2000.     return $this
  2001.     }
  2002.     [$this sectNameSet] contents {
  2003.     typedef
  2004.     }
  2005.     [$this sections] addSects [[$this sectNameSet] contents]
  2006.     # End constructor user section
  2007.     return $this
  2008. }
  2009.  
  2010. method FTTypeDef::destructor {this} {
  2011.     # Start destructor user section
  2012.     # End destructor user section
  2013.     $this FTClass::destructor
  2014. }
  2015.  
  2016. method FTTypeDef::generate {this} {
  2017.     if {[$this isSynthetic]} {
  2018.     return
  2019.     }
  2020.     
  2021.     set sect [[$this sections] getSection typedef]
  2022.     $sect append "typedef [$this name] : [[$this type] getTypeName $this];\n"
  2023. }
  2024.  
  2025. # Do not delete this line -- regeneration end marker
  2026.  
  2027. #---------------------------------------------------------------------------
  2028. #      File:           @(#)ftenum.tcl    /main/hindenburg/3
  2029. #---------------------------------------------------------------------------
  2030.  
  2031. # Start user added include file section
  2032. # End user added include file section
  2033.  
  2034.  
  2035. Class FTEnum : {FTClass} {
  2036.     constructor
  2037.     method destructor
  2038.     method generate
  2039.     method itemSet
  2040.     method addItem
  2041.     method removeItem
  2042.     attribute _itemSet
  2043. }
  2044.  
  2045. constructor FTEnum {class this i_name model i_systemName i_isSynthetic} {
  2046.     set this [FTClass::constructor $class $this $i_name $model $i_systemName $i_isSynthetic]
  2047.     $this _itemSet [List new]
  2048.     # Start constructor user section
  2049.     $this kind ENUM
  2050.     if {[$this isSynthetic]} {
  2051.     return $this
  2052.     }
  2053.     [$this sectNameSet] contents {
  2054.     enum
  2055.     }
  2056.     [$this sections] addSects [[$this sectNameSet] contents]
  2057.     # End constructor user section
  2058.     return $this
  2059. }
  2060.  
  2061. method FTEnum::destructor {this} {
  2062.     # Start destructor user section
  2063.     # End destructor user section
  2064.     $this FTClass::destructor
  2065. }
  2066.  
  2067. method FTEnum::generate {this} {
  2068.     if {[$this isSynthetic]} {
  2069.     return
  2070.     }
  2071.     
  2072.     set sect [[$this sections] getSection enum]
  2073.     $sect append "enum [$this name]\n"
  2074.     $sect indent +
  2075.     [$this itemSet] foreach item {
  2076.     $item generate $sect
  2077.     }
  2078.     $sect indent -
  2079.     $sect append "\nend enum;\n"
  2080. }
  2081.  
  2082. # Do not delete this line -- regeneration end marker
  2083.  
  2084. method FTEnum::itemSet {this} {
  2085.     return [$this _itemSet]
  2086. }
  2087.  
  2088. method FTEnum::addItem {this newItem} {
  2089.     [$this _itemSet] append $newItem
  2090.     $newItem _enum $this
  2091. }
  2092.  
  2093. method FTEnum::removeItem {this oldItem} {
  2094.     $oldItem _enum ""
  2095.     [$this _itemSet] removeValue $oldItem
  2096. }
  2097.  
  2098. #---------------------------------------------------------------------------
  2099. #      File:           @(#)ftparamete.tcl    /main/hindenburg/3
  2100. #---------------------------------------------------------------------------
  2101.  
  2102. # Start user added include file section
  2103. # End user added include file section
  2104.  
  2105.  
  2106. Class FTParameter : {FTObject} {
  2107.     constructor
  2108.     method destructor
  2109.     method generate
  2110.     method method
  2111.     attribute direction
  2112.     attribute asCopy
  2113.     attribute defaultVal
  2114.     attribute _method
  2115.     attribute type
  2116. }
  2117.  
  2118. constructor FTParameter {class this i_name i_direction method type} {
  2119.     set this [FTObject::constructor $class $this $i_name]
  2120.     $this asCopy 0
  2121.     $this direction $i_direction
  2122.     $this _method $method
  2123.     [$method _paramSet] append $this
  2124.     $this type $type
  2125.     # Start constructor user section
  2126.     # End constructor user section
  2127.     return $this
  2128. }
  2129.  
  2130. method FTParameter::destructor {this} {
  2131.     # Start destructor user section
  2132.     # End destructor user section
  2133.     $this FTObject::destructor
  2134. }
  2135.  
  2136. method FTParameter::generate {this pre sect curClass} {
  2137.     $sect append "${pre}"
  2138.     if {[$this asCopy] && [[$this type] isClassType]} {
  2139.     $sect append "copy "
  2140.     }
  2141.     if {[$this direction] != ""} {
  2142.     $sect append "[$this direction] "
  2143.     }
  2144.     if {[$this type] != ""} {
  2145.     [$this type] generate [$this name] $sect $curClass
  2146.     } else {
  2147.     $sect append [$this name]
  2148.     }
  2149.     if {[$this defaultVal] != ""} {
  2150.     $sect append " = [$this defaultVal]"
  2151.     }
  2152. }
  2153.  
  2154. # Do not delete this line -- regeneration end marker
  2155.  
  2156. method FTParameter::method {this args} {
  2157.     if {$args == ""} {
  2158.         return [$this _method]
  2159.     }
  2160.     set ref [$this _method]
  2161.     if {$ref != ""} {
  2162.         [$ref _paramSet] removeValue $this
  2163.     }
  2164.     set obj [lindex $args 0]
  2165.     if {$obj != ""} {
  2166.         [$obj _paramSet] append $this
  2167.     }
  2168.     $this _method $obj
  2169. }
  2170.  
  2171. #---------------------------------------------------------------------------
  2172. #      File:           @(#)ftcmnattri.tcl    /main/hindenburg/2
  2173. #---------------------------------------------------------------------------
  2174.  
  2175. # Start user added include file section
  2176. # End user added include file section
  2177.  
  2178.  
  2179. Class FTCmnAttrib : {FTAttribute} {
  2180.     constructor
  2181.     method destructor
  2182.     method generate
  2183. }
  2184.  
  2185. constructor FTCmnAttrib {class this i_name type access theClass} {
  2186.     set this [FTAttribute::constructor $class $this $i_name $type $access $theClass]
  2187.     # Start constructor user section
  2188.     # End constructor user section
  2189.     return $this
  2190. }
  2191.  
  2192. method FTCmnAttrib::destructor {this} {
  2193.     # Start destructor user section
  2194.     # End destructor user section
  2195.     $this FTAttribute::destructor
  2196. }
  2197.  
  2198. method FTCmnAttrib::generate {this} {
  2199.     set sect [[[$this theClass] sections] getSection attribute]
  2200.     $this genAccess $sect
  2201.     $sect append "attribute "
  2202.     [$this type] generate [$this name] $sect [$this theClass]
  2203.     $sect append ";\n"
  2204. }
  2205.  
  2206. # Do not delete this line -- regeneration end marker
  2207.  
  2208. #---------------------------------------------------------------------------
  2209. #      File:           @(#)ftdomclass.tcl    /main/hindenburg/1
  2210. #---------------------------------------------------------------------------
  2211.  
  2212. # Start user added include file section
  2213. # End user added include file section
  2214.  
  2215.  
  2216. Class FTDomClass : {FTCmnClass} {
  2217.     constructor
  2218.     method destructor
  2219. }
  2220.  
  2221. constructor FTDomClass {class this i_name model i_systemName i_isSynthetic} {
  2222.     set this [FTCmnClass::constructor $class $this $i_name $model $i_systemName $i_isSynthetic]
  2223.     # Start constructor user section
  2224.     # End constructor user section
  2225.     return $this
  2226. }
  2227.  
  2228. method FTDomClass::destructor {this} {
  2229.     # Start destructor user section
  2230.     # End destructor user section
  2231.     $this FTCmnClass::destructor
  2232. }
  2233.  
  2234. # Do not delete this line -- regeneration end marker
  2235.  
  2236.