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