home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / corbamdl.tcl < prev    next >
Text File  |  1997-12-01  |  48KB  |  1,892 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            : corbamdl.tcl
  17. #       Author          : 
  18. #       Original date   : November 1997
  19. #       Description     : Classes for code generation
  20. #
  21. #---------------------------------------------------------------------------
  22.  
  23.  
  24. #      File:           @(#)idgbasetyp.tcl    /main/titanic/3
  25.  
  26.  
  27. Class IDGBaseType : {Object} {
  28.     constructor
  29.     method destructor
  30.     method generate
  31. }
  32.  
  33. constructor IDGBaseType {class this} {
  34.     # Start constructor user section
  35.     # End constructor user section
  36.     return $this
  37. }
  38.  
  39. method IDGBaseType::destructor {this} {
  40.     # Start destructor user section
  41.     # End destructor user section
  42. }
  43.  
  44. method IDGBaseType::generate {this {name ""}} {
  45.     set type [$this getType3GL]
  46.     if {[regexp {\[} $type]} {
  47.     set type [[IDGDataMgr::getMgr] getArrayTD $type]
  48.     }
  49.     if {$name == ""} {
  50.     return $type
  51.     }
  52.     return "$type $name"
  53. }
  54.  
  55. # Do not delete this line -- regeneration end marker
  56.  
  57. if [isCommand CMBaseType] {
  58.     Class  IDGBaseTypeD : {IDGBaseType CMBaseType} {
  59.     }
  60. } else {
  61.     Class IDGBaseTypeD : {IDGBaseType OPBaseType} {    
  62.     }
  63. }
  64.  
  65. global mostDerivedOOPL ; set mostDerivedOOPL(OPBaseType) IDGBaseTypeD
  66.  
  67. selfPromoter OPBaseType {this} {
  68.     IDGBaseTypeD promote $this
  69. }
  70.  
  71.  
  72. #---------------------------------------------------------------------------
  73. #      File:           @(#)idgclassty.tcl    /main/titanic/3
  74.  
  75.  
  76. Class IDGClassType : {Object} {
  77.     constructor
  78.     method destructor
  79.     method generate
  80. }
  81.  
  82. constructor IDGClassType {class this} {
  83.     # Start constructor user section
  84.     # End constructor user section
  85.     return $this
  86. }
  87.  
  88. method IDGClassType::destructor {this} {
  89.     # Start destructor user section
  90.     # End destructor user section
  91. }
  92.  
  93. method IDGClassType::generate {this {name ""}} {
  94.     set type [$this getName]
  95.     if {$type == ""} {
  96.     set type "void"
  97.     } else {
  98.     set class [$this ooplClass]
  99.     if {$class == ""} {
  100.         m4_error $E_NOT_DEFINED $type
  101.     } else {
  102.         set system [$class definingSystem]
  103.         if {$system == ""} {
  104.         m4_error $E_NOT_DEFINED $type
  105.         }
  106.         set idlMgr [IDGDataMgr::getMgr]
  107.         if {$system == [getCurrentSystemName]} {
  108.         if {[$class isInterface]} {
  109.             $idlMgr addForward $type
  110.         } else {
  111.             $class generate
  112.         }
  113.         } else {
  114.         if {$system != ""} {
  115.             $idlMgr addInclude $system
  116.         }
  117.         set type "${system}::$type"
  118.         }
  119.     }
  120.     }
  121.  
  122.     return [string trim "$type $name"]
  123. }
  124.  
  125. # Do not delete this line -- regeneration end marker
  126.  
  127. if [isCommand CMClassType] {
  128.     Class  IDGClassTypeD : {IDGClassType CMClassType} {
  129.     }
  130. } else {
  131.     Class IDGClassTypeD : {IDGClassType OPClassType} {    
  132.     }
  133. }
  134.  
  135. global mostDerivedOOPL ; set mostDerivedOOPL(OPClassType) IDGClassTypeD
  136.  
  137. selfPromoter OPClassType {this} {
  138.     IDGClassTypeD promote $this
  139. }
  140.  
  141.  
  142. #---------------------------------------------------------------------------
  143. #      File:           @(#)idgcmnclas.tcl    /main/titanic/6
  144.  
  145.  
  146. Class IDGCmnClass : {Object} {
  147.     constructor
  148.     method destructor
  149.     method promoter
  150.     method generate
  151.     method genInterface
  152.     method genException
  153.     method genStructure
  154.     method genUnion
  155.     method genSequence
  156.     method genFields
  157.     method genDescription
  158.     method isInterface
  159.     method isIDLSpecial
  160.     method isDerivable
  161.     method definingSystem
  162.     attribute isGenerated
  163.     attribute _isIDLSpecial
  164. }
  165.  
  166. constructor IDGCmnClass {class this name} {
  167.     set this [Object::constructor $class $this $name]
  168.     $this isGenerated 0
  169.     $this _isIDLSpecial -1
  170.     # Start constructor user section
  171.     # End constructor user section
  172.     return $this
  173. }
  174.  
  175. method IDGCmnClass::destructor {this} {
  176.     # Start destructor user section
  177.     # End destructor user section
  178. }
  179.  
  180. method IDGCmnClass::promoter {this} {
  181.     $this isGenerated 0
  182.     $this _isIDLSpecial -1
  183. }
  184.  
  185. method IDGCmnClass::generate {this} {
  186.     if {[$this isGenerated]} {
  187.     return
  188.     }
  189.     $this isGenerated 1
  190.  
  191.     set classType [$this getPropertyValue class_type]
  192.     if {$classType == ""} {
  193.     set classType Interface
  194.     }
  195.  
  196.     set msg "Generating for"
  197.     if {[[IDGDataMgr::getMgr] checkOnly]} {
  198.     set msg Checking
  199.     }
  200.     puts stdout "$msg $classType '[$this getName]'"
  201.  
  202.     if {$msg == "Checking"} {
  203.     set allMethods [$this findMethods 1]
  204.     foreach oper1 $allMethods {
  205.         foreach oper2 $allMethods {
  206.         if {$oper1 >= $oper2} {
  207.             continue
  208.         }
  209.         if {[$oper1 getName] == [$oper2 getName]} {
  210.             m4_error $E_MBR_OVERLOADED Method [$oper1 getName]
  211.         }
  212.         }
  213.     }
  214.     }
  215.  
  216.     if {[info procs IDGCmnClass::gen$classType] != ""} {
  217.     $this gen$classType
  218.     }
  219. }
  220.  
  221. method IDGCmnClass::genInterface {this} {
  222.     set name [$this getName]
  223.     set sect [[IDGDataMgr::getMgr] getSect interface]
  224.     
  225.     # in corba, all supers must be generated first
  226.     #
  227.     set superList ""
  228.     foreach super [$this genNodeSet] {
  229.     set superString [$super generate]
  230.     if {$superString != ""} {
  231.         lappend superList $superString
  232.     }
  233.     }
  234.  
  235.     # now, we can safely generate this class
  236.     #
  237.     $this genDescription $sect
  238.     $sect append "interface $name"
  239.  
  240.     if {$superList != {}} {
  241.     $sect append " : [join $superList {, }]"
  242.     }
  243.  
  244.     $sect append "\n\{\n"
  245.     $sect indent +
  246.  
  247.     # feature list
  248.     foreach feat [$this featureSet] {
  249.     $feat generate
  250.     }
  251.     
  252.     $sect indent -
  253.     $sect append "\};\n\n"
  254. }
  255.  
  256. method IDGCmnClass::genException {this} {
  257.     set name [$this getName]
  258.  
  259.     if {[$this genNodeSet] != {} || [$this specNodeSet] != {}} {
  260.     m4_error $E_NO_INHERITANCE Exception $name
  261.     }
  262.  
  263.     if {![$this genFields Exception]} {
  264.     return
  265.     }
  266.  
  267.     set sect [[IDGDataMgr::getMgr] getSect nonInterface]
  268.     $this genDescription $sect
  269.  
  270.     $sect append "exception $name \{\n"
  271.     $sect indent +
  272.  
  273.     # generate feature list
  274.     foreach feat [$this featureSet] {
  275.     if {[$feat get_obj_type] == "data_attrib"} {
  276.         $feat genMember $sect
  277.     }
  278.     }
  279.     
  280.     $sect indent -
  281.     $sect append "\};\n\n"
  282. }
  283.  
  284. method IDGCmnClass::genStructure {this} {
  285.     set name [$this getName]
  286.  
  287.     if {[$this genNodeSet] != {} || [$this specNodeSet] != {}} {
  288.     m4_error $E_NO_INHERITANCE Structure $name
  289.     }
  290.  
  291.     if {![$this genFields Structure]} {
  292.     return
  293.     }
  294.  
  295.     set sect [[IDGDataMgr::getMgr] getSect nonInterface]
  296.     $this genDescription $sect
  297.  
  298.     $sect append "struct $name \{\n"
  299.     $sect indent +
  300.  
  301.     # generate feature list
  302.     foreach feat [$this featureSet] {
  303.     if {[$feat get_obj_type] == "data_attrib"} {
  304.         $feat genMember $sect
  305.     }
  306.     }
  307.     
  308.     $sect indent -
  309.     $sect append "\};\n\n"
  310. }
  311.  
  312. method IDGCmnClass::genUnion {this} {
  313.     set name [$this getName]
  314.     
  315.     if {[$this genNodeSet] != {} || [$this specNodeSet] != {}} {
  316.     m4_error $E_NO_INHERITANCE Union $name
  317.     }
  318.  
  319.     if {![$this genFields Union]} {
  320.     return
  321.     }
  322.  
  323.     set sect [[IDGDataMgr::getMgr] getSect nonInterface]
  324.     $this genDescription $sect
  325.  
  326.     set discriminator [string trim [$this getPropertyValue discriminator]]
  327.     if {$discriminator == ""} {
  328.     set discriminator long
  329.     }
  330.     $sect append "union $name\nswitch ($discriminator) \{\n"
  331.     $sect indent +
  332.     
  333.     set case 0
  334.     foreach feat [$this featureSet] {
  335.     if {[$feat get_obj_type] == "data_attrib"} {
  336.         set caseLabel [string trim [$feat getPropertyValue case_label]]
  337.         if {$caseLabel == ""} {
  338.         set caseLabel $case
  339.         }
  340.         if {$caseLabel != "default"} {
  341.         set caseLabel "case $caseLabel"
  342.         }
  343.         $sect append "$caseLabel: "
  344.         $feat genMember $sect
  345.         incr case
  346.     }
  347.     }
  348.  
  349.     $sect indent -
  350.     $sect append "\};\n\n"
  351. }
  352.  
  353. method IDGCmnClass::genSequence {this} {
  354.     set name [$this getName]
  355.  
  356.     if {[$this get_obj_type] != "class_typedef"} {
  357.     m4_error $E_NEED_ONE_ATTRIB $name
  358.     return
  359.     }
  360.  
  361.     set sect [[IDGDataMgr::getMgr] getSect nonInterface]
  362.     $this genDescription $sect
  363.  
  364.     set feat [$this featureSet]
  365.     set type [[$feat ooplType] generate]
  366.     $sect append "typedef sequence< $type > $name;\n\n"
  367.  
  368.     ## can one derive from a sequence in IDL???
  369.     if {[$this specNodeSet] != {}} {
  370.     m4_error $E_NO_SUBCLASSES Sequence $name ""
  371.     }
  372. }
  373.  
  374. method IDGCmnClass::genFields {this forWhat} {
  375.     # define/declare/include types used in feature list
  376.     set noError 1
  377.     foreach feat [$this featureSet] {
  378.     # Check features for validity here
  379.     set objType [$feat get_obj_type]
  380.     if {$objType == "data_attrib"} {
  381.         [$feat ooplType] generate
  382.     } elseif {$objType != "constructor"} {
  383.         m4_error $E_ONLY_DATA_ATTRS $forWhat [$this getName]
  384.         set noError 0
  385.     }
  386.     }
  387.     return $noError
  388. }
  389.  
  390. method IDGCmnClass::genDescription {this sect} {
  391.     set ftext [$this getFreeText]
  392.     if {$ftext != ""} {
  393.     $sect append "\n"
  394.     string_to_oopl_comment $sect $ftext "//"
  395.     }
  396. }
  397.  
  398. method IDGCmnClass::isInterface {this} {
  399.     return 0
  400. }
  401.  
  402. method IDGCmnClass::isIDLSpecial {this} {
  403.     # this should be done in promoter, but at this time OPClass (C++) is not
  404.     # fully constructed
  405.     #
  406.     if {[$this _isIDLSpecial] == -1} {
  407.     set classType [$this getPropertyValue class_type]
  408.     if {$classType != "" && $classType != "Interface"} {
  409.         $this _isIDLSpecial 1
  410.     } else {
  411.         $this _isIDLSpecial 0
  412.     }
  413.     }
  414.     return [$this _isIDLSpecial]
  415. }
  416.  
  417. method IDGCmnClass::isDerivable {this} {
  418.     if {[$this isIDLSpecial]} {
  419.     return 0
  420.     }
  421.     return 1
  422. }
  423.  
  424. method IDGCmnClass::definingSystem {this} {
  425.     set systemV [[$this smNode] getDefiningSystemVersion]
  426.     if {![$systemV isNil]} {
  427.     return [[$systemV system] name]
  428.     }
  429.     return ""
  430. }
  431.  
  432. # Do not delete this line -- regeneration end marker
  433.  
  434.  
  435.  
  436. #---------------------------------------------------------------------------
  437. #      File:           @(#)idgenumtyp.tcl    /main/titanic/2
  438.  
  439.  
  440. Class IDGEnumType : {Object} {
  441.     constructor
  442.     method destructor
  443.     method generate
  444. }
  445.  
  446. constructor IDGEnumType {class this} {
  447.     # Start constructor user section
  448.     # End constructor user section
  449.     return $this
  450. }
  451.  
  452. method IDGEnumType::destructor {this} {
  453.     # Start destructor user section
  454.     # End destructor user section
  455. }
  456.  
  457. method IDGEnumType::generate {this {name ""}} {
  458.     # in 1st definition section (enum)
  459.     #
  460.     set type [$this getName]
  461.     if {$type == ""} {
  462.     set type "void"
  463.     } else {
  464.     set class [$this ooplClass]
  465.     set system [$class definingSystem]
  466.     if {$system == ""} {
  467.         m4_error $E_NOT_DEFINED $type
  468.     }
  469.     if {$system != [getCurrentSystemName]} {
  470.         set type "${system}::$type"
  471.         if {$system != ""} {
  472.         [IDGDataMgr::getMgr] addInclude $system
  473.         }
  474.     }
  475.     }
  476.     return [string trim "$type $name"]
  477. }
  478.  
  479. # Do not delete this line -- regeneration end marker
  480.  
  481. if [isCommand CMEnumType] {
  482.     Class  IDGEnumTypeD : {IDGEnumType CMEnumType} {
  483.     }
  484. } else {
  485.     Class IDGEnumTypeD : {IDGEnumType OPEnumType} {    
  486.     }
  487. }
  488.  
  489. global mostDerivedOOPL ; set mostDerivedOOPL(OPEnumType) IDGEnumTypeD
  490.  
  491. selfPromoter OPEnumType {this} {
  492.     IDGEnumTypeD promote $this
  493. }
  494.  
  495.  
  496. #---------------------------------------------------------------------------
  497. #      File:           @(#)idginhgrou.tcl    /main/titanic/2
  498.  
  499.  
  500. Class IDGInhGroup : {Object} {
  501.     constructor
  502.     method destructor
  503.     method generate
  504. }
  505.  
  506. constructor IDGInhGroup {class this} {
  507.     # Start constructor user section
  508.     # End constructor user section
  509.     return $this
  510. }
  511.  
  512. method IDGInhGroup::destructor {this} {
  513.     # Start destructor user section
  514.     # End destructor user section
  515. }
  516.  
  517. method IDGInhGroup::generate {this} {
  518.     set access [$this inherAccess]
  519.     if {$access != "Public" && $access != ""} {
  520.     return ""
  521.     }
  522.  
  523.     set class [$this superClass]
  524.     set name [$class getName]
  525.     set idlMgr [IDGDataMgr::getMgr]
  526.     if {[$class isExternal]} {
  527.     set system [$class definingSystem]
  528.     if {$system == ""} {
  529.         m4_error $E_NOT_DEFINED $name
  530.     } else {
  531.         $idlMgr addInclude $system
  532.     }
  533.     set name "$system::$name"
  534.     } else {
  535.     # local
  536.     if {$name != ""} {
  537.         $class generate
  538.     }
  539.     }
  540.     return $name
  541. }
  542.  
  543. # Do not delete this line -- regeneration end marker
  544.  
  545. if [isCommand CMInhGroup] {
  546.     Class  IDGInhGroupD : {IDGInhGroup CMInhGroup} {
  547.     }
  548. } else {
  549.     Class IDGInhGroupD : {IDGInhGroup OPInhGroup} {    
  550.     }
  551. }
  552.  
  553. global mostDerivedOOPL ; set mostDerivedOOPL(OPInhGroup) IDGInhGroupD
  554.  
  555. selfPromoter OPInhGroup {this} {
  556.     IDGInhGroupD promote $this
  557. }
  558.  
  559.  
  560. #---------------------------------------------------------------------------
  561. #      File:           @(#)idgobject.tcl    /main/titanic/2
  562.  
  563.  
  564. Class IDGObject : {Object} {
  565.     constructor
  566.     method destructor
  567.     method genDescription
  568. }
  569.  
  570. constructor IDGObject {class this name} {
  571.     set this [Object::constructor $class $this $name]
  572.     # Start constructor user section
  573.     # End constructor user section
  574.     return $this
  575. }
  576.  
  577. method IDGObject::destructor {this} {
  578.     # Start destructor user section
  579.     # End destructor user section
  580. }
  581.  
  582. method IDGObject::genDescription {this sect} {
  583.     set ftext [$this getFreeText]
  584.     if {$ftext != ""} {
  585.     string_to_oopl_comment $sect $ftext "//"
  586.     }
  587. }
  588.  
  589. # Do not delete this line -- regeneration end marker
  590.  
  591.  
  592.  
  593. #---------------------------------------------------------------------------
  594. #      File:           @(#)idgtypedef.tcl    /main/titanic/2
  595.  
  596.  
  597. Class IDGTypeDefType : {Object} {
  598.     constructor
  599.     method destructor
  600.     method generate
  601. }
  602.  
  603. constructor IDGTypeDefType {class this} {
  604.     # Start constructor user section
  605.     # End constructor user section
  606.     return $this
  607. }
  608.  
  609. method IDGTypeDefType::destructor {this} {
  610.     # Start destructor user section
  611.     # End destructor user section
  612. }
  613.  
  614. method IDGTypeDefType::generate {this {name ""}} {
  615.     set type [$this getName]
  616.     if {$type == ""} {
  617.     set type "void"
  618.     } else {
  619.     set class [$this ooplClass]
  620.     set system [$class definingSystem]
  621.     if {$system == ""} {
  622.         m4_error $E_NOT_DEFINED $type
  623.     }
  624.     set idlMgr [IDGDataMgr::getMgr]
  625.     if {$system == [getCurrentSystemName]} {
  626.         if {[$class isInterface]} {
  627.         $idlMgr addForward $type
  628.         } else {
  629.         $class generate
  630.         }
  631.     } else {
  632.         set type "${system}::$type"
  633.         if {$system != ""} {
  634.         $idlMgr addInclude $system
  635.         }
  636.     }
  637.     }
  638.     return [string trim "$type $name"]
  639. }
  640.  
  641. # Do not delete this line -- regeneration end marker
  642.  
  643. if [isCommand CMTypeDefType] {
  644.     Class  IDGTypeDefTypeD : {IDGTypeDefType CMTypeDefType} {
  645.     }
  646. } else {
  647.     Class IDGTypeDefTypeD : {IDGTypeDefType OPTypeDefType} {    
  648.     }
  649. }
  650.  
  651. global mostDerivedOOPL ; set mostDerivedOOPL(OPTypeDefType) IDGTypeDefTypeD
  652.  
  653. selfPromoter OPTypeDefType {this} {
  654.     IDGTypeDefTypeD promote $this
  655. }
  656.  
  657.  
  658. #---------------------------------------------------------------------------
  659. #      File:           @(#)idgdatamgr.tcl    /main/titanic/3
  660.  
  661.  
  662. Class IDGDataMgr : {GCObject} {
  663.     constructor
  664.     method destructor
  665.     method write
  666.     method addInclude
  667.     method addForward
  668.     method removeSect
  669.     method getArrayTD
  670.     method delMgr
  671.     method addArrayTD
  672.     method removeArrayTD
  673.     method getSect
  674.     attribute checkOnly
  675.     attribute sectNameSet
  676.     attribute includeSet
  677.     attribute forwardSet
  678.     attribute arrayTDSet
  679.     attribute sect
  680. }
  681.  
  682. global IDGDataMgr::mgr
  683. set IDGDataMgr::mgr NULL
  684.  
  685.  
  686. constructor IDGDataMgr {class this} {
  687.     set this [GCObject::constructor $class $this]
  688.     $this checkOnly 0
  689.     $this sectNameSet [List new]
  690.     $this includeSet [List new]
  691.     $this forwardSet [List new]
  692.     $this arrayTDSet [List new]
  693.     $this sect [Dictionary new]
  694.     # Start constructor user section
  695.  
  696.     [$this sectNameSet] contents {
  697.     fileHeader
  698.     includes
  699.     header
  700.     forwardDecl
  701.     enum
  702.     nonInterface
  703.     interface
  704.     moduleTrailer
  705.     trailer
  706.     fileTrailer
  707.     }
  708.  
  709.     [$this sectNameSet] foreach sect {
  710.     set newSect [TextSection new]
  711.     [$this sect] set $sect $newSect
  712.     $newSect indent 1 "\t"
  713.     }
  714.     foreach sect {includes header trailer fileHeader fileTrailer} {
  715.     [[$this sect] set $sect] indent 0 "\t"
  716.     }
  717.  
  718.     # End constructor user section
  719.     return $this
  720. }
  721.  
  722. method IDGDataMgr::destructor {this} {
  723.     # Start destructor user section
  724.     # End destructor user section
  725. }
  726.  
  727. method IDGDataMgr::write {this fileName} {
  728.     [$this sectNameSet] foreach sect {
  729.     [[$this sect] set $sect] write $fileName
  730.     }
  731. }
  732.  
  733. method IDGDataMgr::addInclude {this name {pathCompletion 1}} {
  734.     if {$name == ""} {
  735.     return
  736.     }
  737.     if {$pathCompletion} {
  738.     set name "\"[location .. $name ${name}.idl]\""
  739.     }
  740.     if {[[$this includeSet] search -exact $name] == -1} {
  741.     [$this includeSet] append $name
  742.     }
  743. }
  744.  
  745. method IDGDataMgr::addForward {this name} {
  746.     if {$name == ""} {
  747.     return
  748.     }
  749.     if {[[$this forwardSet] search -exact $name] == -1} {
  750.     [$this forwardSet] append $name
  751.     }
  752. }
  753.  
  754. method IDGDataMgr::removeSect {this name} {
  755.     [$this sect] unset $name
  756.     [$this sectNameSet] removeValue $name
  757. }
  758.  
  759. method IDGDataMgr::getArrayTD {this type} {
  760.     regexp {\[([0-9]*)\]} $type dummy index
  761.     regsub {\[.*} $type "" type
  762.     set name arr_$type$index
  763.     set i [[$this arrayTDSet] search -exact $name]
  764.     if {$i == -1} {
  765.     [$this arrayTDSet] append $name
  766.     [$this getSect nonInterface] append "typedef $type $name\[$index];\n\n"
  767.     }
  768.     return $name
  769. }
  770.  
  771. proc IDGDataMgr::getMgr {} {
  772.     global IDGDataMgr::mgr
  773.     if {${IDGDataMgr::mgr} == "NULL"} {
  774.     set IDGDataMgr::mgr [IDGDataMgr new]
  775.     }
  776.     return ${IDGDataMgr::mgr}
  777. }
  778.  
  779. method IDGDataMgr::delMgr {this} {
  780.     global IDGDataMgr::mgr
  781.     set IDGDataMgr::mgr NULL
  782. }
  783.  
  784. # Do not delete this line -- regeneration end marker
  785.  
  786. method IDGDataMgr::addArrayTD {this newArrayTD} {
  787.     [$this arrayTDSet] append $newArrayTD
  788.  
  789. }
  790.  
  791. method IDGDataMgr::removeArrayTD {this oldArrayTD} {
  792.     [$this arrayTDSet] removeValue $oldArrayTD
  793. }
  794.  
  795. method IDGDataMgr::getSect {this name} {
  796.     return [[$this sect] set $name]
  797. }
  798.  
  799.  
  800.  
  801. #---------------------------------------------------------------------------
  802. #      File:           @(#)idgclass.tcl    /main/titanic/2
  803.  
  804.  
  805. Class IDGClass : {IDGCmnClass} {
  806.     constructor
  807.     method destructor
  808.     method isInterface
  809. }
  810.  
  811. constructor IDGClass {class this name} {
  812.     set this [IDGCmnClass::constructor $class $this $name]
  813.     # Start constructor user section
  814.     # End constructor user section
  815.     return $this
  816. }
  817.  
  818. method IDGClass::destructor {this} {
  819.     # Start destructor user section
  820.     # End destructor user section
  821. }
  822.  
  823. method IDGClass::isInterface {this} {
  824.     return [expr ![$this isIDLSpecial]]
  825. }
  826.  
  827. # Do not delete this line -- regeneration end marker
  828.  
  829. if [isCommand CMClass] {
  830.     Class  IDGClassD : {IDGClass CMClass} {
  831.     }
  832. } else {
  833.     Class IDGClassD : {IDGClass OPClass} {    
  834.     }
  835. }
  836.  
  837. global mostDerivedOOPL ; set mostDerivedOOPL(OPClass) IDGClassD
  838.  
  839. selfPromoter OPClass {this} {
  840.     IDGClassD promote $this
  841. }
  842.  
  843.  
  844. #---------------------------------------------------------------------------
  845. #      File:           @(#)idgclassen.tcl    /main/titanic/2
  846.  
  847.  
  848. Class IDGClassEnum : {IDGCmnClass} {
  849.     constructor
  850.     method destructor
  851.     method genInterface
  852.     method isDerivable
  853. }
  854.  
  855. constructor IDGClassEnum {class this name} {
  856.     set this [IDGCmnClass::constructor $class $this $name]
  857.     # Start constructor user section
  858.     # End constructor user section
  859.     return $this
  860. }
  861.  
  862. method IDGClassEnum::destructor {this} {
  863.     # Start destructor user section
  864.     # End destructor user section
  865. }
  866.  
  867. method IDGClassEnum::genInterface {this} {
  868.     set name [$this getName]
  869.     set sect [[IDGDataMgr::getMgr] getSect enum]
  870.  
  871.     $this genDescription $sect
  872.  
  873.     $sect append "enum $name \{\n"
  874.     $sect indent +
  875.     set featList {}
  876.     foreach feat [$this featureSet] {
  877.     lappend featList [$feat getName]
  878.     }
  879.     $sect append [join $featList ",\n"]
  880.     $sect append "\n"
  881.     $sect indent -
  882.     $sect append "\};\n\n"
  883.  
  884.     ## can one derive from an enum in IDL???
  885.     if {[$this specNodeSet] != {} && ![$this isDerivable]} {
  886.     m4_error $E_NO_SUBCLASSES "Enumeration Class" $name ""
  887.     }
  888. }
  889.  
  890. method IDGClassEnum::isDerivable {this} {
  891.     return 0
  892. }
  893.  
  894. # Do not delete this line -- regeneration end marker
  895.  
  896. if [isCommand CMClassEnum] {
  897.     Class  IDGClassEnumD : {IDGClassEnum CMClassEnum} {
  898.     }
  899. } else {
  900.     Class IDGClassEnumD : {IDGClassEnum OPClassEnum} {    
  901.     }
  902. }
  903.  
  904. global mostDerivedOOPL ; set mostDerivedOOPL(OPClassEnum) IDGClassEnumD
  905.  
  906. selfPromoter OPClassEnum {this} {
  907.     IDGClassEnumD promote $this
  908. }
  909.  
  910.  
  911. #---------------------------------------------------------------------------
  912. #      File:           @(#)idgclassge.tcl    /main/titanic/4
  913.  
  914.  
  915. Class IDGClassGenericTypeDef : {IDGCmnClass} {
  916.     constructor
  917.     method destructor
  918.     method isInterface
  919. }
  920.  
  921. constructor IDGClassGenericTypeDef {class this name} {
  922.     set this [IDGCmnClass::constructor $class $this $name]
  923.     # Start constructor user section
  924.     # End constructor user section
  925.     return $this
  926. }
  927.  
  928. method IDGClassGenericTypeDef::destructor {this} {
  929.     # Start destructor user section
  930.     # End destructor user section
  931. }
  932.  
  933. method IDGClassGenericTypeDef::isInterface {this} {
  934.     return [expr ![$this isIDLSpecial]]
  935. }
  936.  
  937. # Do not delete this line -- regeneration end marker
  938.  
  939. if [isCommand CMClassGenericTypeDef] {
  940.     Class  IDGClassGenericTypeDefD : {IDGClassGenericTypeDef CMClassGenericTypeDef} {
  941.     }
  942. } else {
  943.     Class IDGClassGenericTypeDefD : {IDGClassGenericTypeDef OPClassGenericTypeDef} {    
  944.     }
  945. }
  946.  
  947. global mostDerivedOOPL ; set mostDerivedOOPL(OPClassGenericTypeDef) IDGClassGenericTypeDefD
  948.  
  949. selfPromoter OPClassGenericTypeDef {this} {
  950.     IDGClassGenericTypeDefD promote $this
  951. }
  952.  
  953.  
  954. #---------------------------------------------------------------------------
  955. #      File:           @(#)idgclasstd.tcl    /main/titanic/2
  956.  
  957.  
  958. Class IDGClassTDef : {IDGCmnClass} {
  959.     constructor
  960.     method destructor
  961.     method genInterface
  962.     method isDerivable
  963. }
  964.  
  965. constructor IDGClassTDef {class this name} {
  966.     set this [IDGCmnClass::constructor $class $this $name]
  967.     # Start constructor user section
  968.     # End constructor user section
  969.     return $this
  970. }
  971.  
  972. method IDGClassTDef::destructor {this} {
  973.     # Start destructor user section
  974.     # End destructor user section
  975. }
  976.  
  977. method IDGClassTDef::genInterface {this} {
  978.     set name [$this getName]
  979.     set sect [[IDGDataMgr::getMgr] getSect nonInterface]
  980.  
  981.     set feat [$this featureSet]
  982.     set initialValue [$feat getInitialValue]
  983.     if {$initialValue == ""} {
  984.     # typedef
  985.     $this genDescription $sect
  986.     $sect append "typedef [[$feat ooplType] generate $name];\n\n"
  987.     if {[$this specNodeSet] != {}} {
  988.         if {![$this isDerivable]} {
  989.         m4_error $E_NO_SUBCLASSES "Typedef Class" $name "since it is a standard type"
  990.         }
  991.     }
  992.     } else {
  993.     # constant
  994.     $this genDescription $sect
  995.     $sect append "const [[$feat ooplType] generate [$feat getName]] = $initialValue;\n\n"
  996.     if {[$this specNodeSet] != {}} {
  997.         m4_error $E_NO_SUBCLASSES "Constant definition" [$this getName] ""
  998.     }
  999.     }
  1000. }
  1001.  
  1002. method IDGClassTDef::isDerivable {this} {
  1003.     set attrib [lindex [$this featureSet] 0]
  1004.     if {[[$attrib ooplType] getType3GL] == ""} {
  1005.     return 1
  1006.     }
  1007.     return 0
  1008. }
  1009.  
  1010. # Do not delete this line -- regeneration end marker
  1011.  
  1012. if [isCommand CMClassTDef] {
  1013.     Class  IDGClassTDefD : {IDGClassTDef CMClassTDef} {
  1014.     }
  1015. } else {
  1016.     Class IDGClassTDefD : {IDGClassTDef OPClassTDef} {    
  1017.     }
  1018. }
  1019.  
  1020. global mostDerivedOOPL ; set mostDerivedOOPL(OPClassTDef) IDGClassTDefD
  1021.  
  1022. selfPromoter OPClassTDef {this} {
  1023.     IDGClassTDefD promote $this
  1024. }
  1025.  
  1026.  
  1027. #---------------------------------------------------------------------------
  1028. #      File:           @(#)idglinkcla.tcl    /main/titanic/4
  1029.  
  1030.  
  1031. Class IDGLinkClass : {IDGCmnClass} {
  1032.     constructor
  1033.     method destructor
  1034.     method generate
  1035.     method genInterface
  1036.     method isInterface
  1037. }
  1038.  
  1039. constructor IDGLinkClass {class this name} {
  1040.     set this [IDGCmnClass::constructor $class $this $name]
  1041.     # Start constructor user section
  1042.     # End constructor user section
  1043.     return $this
  1044. }
  1045.  
  1046. method IDGLinkClass::destructor {this} {
  1047.     # Start destructor user section
  1048.     # End destructor user section
  1049. }
  1050.  
  1051. method IDGLinkClass::generate {this} {
  1052.     if {![$this isInterface]} {
  1053.     m4_error $E_ILL_LINKCLASS [$this getName] [$this getPropertyValue class_type]
  1054.     return
  1055.     }
  1056.     $this IDGCmnClass::generate
  1057. }
  1058.  
  1059. method IDGLinkClass::genInterface {this} {
  1060.     if {[$this getName] == ""} {
  1061.     m4_error $E_NO_NAME "Link Class"
  1062.     return
  1063.     }
  1064.     $this IDGCmnClass::genInterface
  1065. }
  1066.  
  1067. method IDGLinkClass::isInterface {this} {
  1068.     return [expr ![$this isIDLSpecial]]
  1069. }
  1070.  
  1071. # Do not delete this line -- regeneration end marker
  1072.  
  1073. if [isCommand CMLinkClass] {
  1074.     Class  IDGLinkClassD : {IDGLinkClass CMLinkClass} {
  1075.     }
  1076. } else {
  1077.     Class IDGLinkClassD : {IDGLinkClass OPLinkClass} {    
  1078.     }
  1079. }
  1080.  
  1081. global mostDerivedOOPL ; set mostDerivedOOPL(OPLinkClass) IDGLinkClassD
  1082.  
  1083. selfPromoter OPLinkClass {this} {
  1084.     IDGLinkClassD promote $this
  1085. }
  1086.  
  1087.  
  1088. #---------------------------------------------------------------------------
  1089. #      File:           @(#)idgcmnattr.tcl    /main/titanic/1
  1090.  
  1091.  
  1092. Class IDGCmnAttr : {IDGObject} {
  1093.     constructor
  1094.     method destructor
  1095.     method splitAccessMode
  1096.     method genAccess
  1097.     method isLegalDest
  1098.     method isAccessible
  1099.     method genAccessers
  1100. }
  1101.  
  1102. constructor IDGCmnAttr {class this name} {
  1103.     set this [IDGObject::constructor $class $this $name]
  1104.     # Start constructor user section
  1105.     # End constructor user section
  1106.     return $this
  1107. }
  1108.  
  1109. method IDGCmnAttr::destructor {this} {
  1110.     # Start destructor user section
  1111.     # End destructor user section
  1112.     $this IDGObject::destructor
  1113. }
  1114.  
  1115. method IDGCmnAttr::splitAccessMode {this access mode} {
  1116.     if {$access == ""} {
  1117.     return Public
  1118.     }
  1119.     set rwAccessList [split $access -]
  1120.     if {[llength $rwAccessList] == 2} {
  1121.     if {$mode == "r"} {
  1122.         return [lindex $rwAccessList 0]
  1123.     }
  1124.     return [lindex $rwAccessList 1]
  1125.     }
  1126.     return $access
  1127. }
  1128.  
  1129. method IDGCmnAttr::genAccess {this access} {
  1130.     if {$access == ""} {
  1131.     return Public
  1132.     } else {
  1133.     return $access
  1134.     }
  1135. }
  1136.  
  1137. method IDGCmnAttr::isLegalDest {this type opposite} {
  1138.     # !! Implement this function !!
  1139. }
  1140.  
  1141. method IDGCmnAttr::isAccessible {this readAccess writeAccess} {
  1142.     # !! Implement this function !!
  1143. }
  1144.  
  1145. method IDGCmnAttr::genAccessers {this funcName funcType sect keyName keyType} {
  1146.     # !! Implement this function !!
  1147. }
  1148.  
  1149. # Do not delete this line -- regeneration end marker
  1150.  
  1151.  
  1152.  
  1153. #---------------------------------------------------------------------------
  1154. #      File:           @(#)idgconstru.tcl    /main/titanic/2
  1155.  
  1156.  
  1157. Class IDGConstructor : {IDGObject} {
  1158.     constructor
  1159.     method destructor
  1160.     method generate
  1161. }
  1162.  
  1163. constructor IDGConstructor {class this name} {
  1164.     set this [IDGObject::constructor $class $this $name]
  1165.     # Start constructor user section
  1166.     # End constructor user section
  1167.     return $this
  1168. }
  1169.  
  1170. method IDGConstructor::destructor {this} {
  1171.     # Start destructor user section
  1172.     # End destructor user section
  1173. }
  1174.  
  1175. method IDGConstructor::generate {this} {
  1176.     # no constructors in idl
  1177.     #
  1178.     return
  1179. }
  1180.  
  1181. # Do not delete this line -- regeneration end marker
  1182.  
  1183. if [isCommand CMConstructor] {
  1184.     Class  IDGConstructorD : {IDGConstructor CMConstructor} {
  1185.     }
  1186. } else {
  1187.     Class IDGConstructorD : {IDGConstructor OPConstructor} {    
  1188.     }
  1189. }
  1190.  
  1191. global mostDerivedOOPL ; set mostDerivedOOPL(OPConstructor) IDGConstructorD
  1192.  
  1193. selfPromoter OPConstructor {this} {
  1194.     IDGConstructorD promote $this
  1195. }
  1196.  
  1197.  
  1198. #---------------------------------------------------------------------------
  1199. #      File:           @(#)idgoperati.tcl    /main/titanic/3
  1200.  
  1201.  
  1202. Class IDGOperation : {IDGObject} {
  1203.     constructor
  1204.     method destructor
  1205.     method generate
  1206. }
  1207.  
  1208. constructor IDGOperation {class this name} {
  1209.     set this [IDGObject::constructor $class $this $name]
  1210.     # Start constructor user section
  1211.     # End constructor user section
  1212.     return $this
  1213. }
  1214.  
  1215. method IDGOperation::destructor {this} {
  1216.     # Start destructor user section
  1217.     # End destructor user section
  1218. }
  1219.  
  1220. method IDGOperation::generate {this} {
  1221.     set name [$this getName]
  1222.  
  1223.     if {$name == "create"} {
  1224.     # this is another constructor
  1225.     return
  1226.     }
  1227.  
  1228.     set type [$this ooplType]
  1229.     if {$type != "" && [$type getName] != ""} {
  1230.     set typeString [string trim [$type generate]]
  1231.     } else {
  1232.     set typeString "void"
  1233.     }
  1234.  
  1235.     set access [$this getPropertyValue method_access]
  1236.     # only public operations are exported
  1237.     if {$access != "Public" && $access != ""} {
  1238.     return
  1239.     }
  1240.  
  1241.     set paramList {}
  1242.     foreach param [$this parameterSet] {
  1243.     lappend paramList [$param generate]
  1244.     }
  1245.  
  1246.     set exceptions [string trim [$this getPropertyValue exceptions]]
  1247.     set oneway ""
  1248.     if {$typeString == "void" && $exceptions == "" && [$this getPropertyValue oneway] != "Off"} {
  1249.     set oneway "oneway "
  1250.     foreach param $paramList {
  1251.         set dir [lindex $param 0]
  1252.         if {$dir != "in" && $dir != ""} {
  1253.         set oneway ""
  1254.         break
  1255.         }
  1256.     }
  1257.     } 
  1258.  
  1259.     set sect [[IDGDataMgr::getMgr] getSect interface]
  1260.     $this genDescription $sect
  1261.  
  1262.     $sect append "${oneway}$typeString ${name}("
  1263.     $sect append [join $paramList ", "]
  1264.     $sect append ")"
  1265.  
  1266.     if {$exceptions != ""} {
  1267.     $sect append " raises($exceptions)"
  1268.     }
  1269.  
  1270.     set context [$this getPropertyValue context]
  1271.     if {$context != ""} {
  1272.     $sect append " context($context)"
  1273.     }
  1274.  
  1275.     $sect append ";\n\n"
  1276. }
  1277.  
  1278. # Do not delete this line -- regeneration end marker
  1279.  
  1280. if [isCommand CMOperation] {
  1281.     Class  IDGOperationD : {IDGOperation CMOperation} {
  1282.     }
  1283. } else {
  1284.     Class IDGOperationD : {IDGOperation OPOperation} {    
  1285.     }
  1286. }
  1287.  
  1288. global mostDerivedOOPL ; set mostDerivedOOPL(OPOperation) IDGOperationD
  1289.  
  1290. selfPromoter OPOperation {this} {
  1291.     IDGOperationD promote $this
  1292. }
  1293.  
  1294.  
  1295. #---------------------------------------------------------------------------
  1296. #      File:           @(#)idgoperpar.tcl    /main/titanic/2
  1297.  
  1298.  
  1299. Class IDGOperParameter : {IDGObject} {
  1300.     constructor
  1301.     method destructor
  1302.     method generate
  1303. }
  1304.  
  1305. constructor IDGOperParameter {class this name} {
  1306.     set this [IDGObject::constructor $class $this $name]
  1307.     # Start constructor user section
  1308.     # End constructor user section
  1309.     return $this
  1310. }
  1311.  
  1312. method IDGOperParameter::destructor {this} {
  1313.     # Start destructor user section
  1314.     # End destructor user section
  1315. }
  1316.  
  1317. method IDGOperParameter::generate {this} {
  1318.     set name [$this getName]
  1319.     set type [$this ooplType]
  1320.     set typeString [$type generate]
  1321.     set direction [$this getPropertyValue direction]
  1322.     if {$direction == ""} {
  1323.     set direction "in"
  1324.     }
  1325.     return "$direction $typeString $name"
  1326. }
  1327.  
  1328. # Do not delete this line -- regeneration end marker
  1329.  
  1330. if [isCommand CMOperParameter] {
  1331.     Class  IDGOperParameterD : {IDGOperParameter CMOperParameter} {
  1332.     }
  1333. } else {
  1334.     Class IDGOperParameterD : {IDGOperParameter OPOperParameter} {    
  1335.     }
  1336. }
  1337.  
  1338. global mostDerivedOOPL ; set mostDerivedOOPL(OPOperParameter) IDGOperParameterD
  1339.  
  1340. selfPromoter OPOperParameter {this} {
  1341.     IDGOperParameterD promote $this
  1342. }
  1343.  
  1344.  
  1345. #---------------------------------------------------------------------------
  1346. #      File:           @(#)idgassocat.tcl    /main/titanic/5
  1347.  
  1348.  
  1349. Class IDGAssocAttr : {IDGCmnAttr} {
  1350.     constructor
  1351.     method destructor
  1352.     method generate
  1353. }
  1354.  
  1355. constructor IDGAssocAttr {class this name} {
  1356.     set this [IDGCmnAttr::constructor $class $this $name]
  1357.     # Start constructor user section
  1358.     # End constructor user section
  1359.     return $this
  1360. }
  1361.  
  1362. method IDGAssocAttr::destructor {this} {
  1363.     # Start destructor user section
  1364.     # End destructor user section
  1365. }
  1366.  
  1367. method IDGAssocAttr::generate {this} {
  1368.     set name [$this getName]
  1369.     set type [$this ooplType]
  1370.     set opposite [$this opposite]
  1371.     if {[$type get_obj_type] != "base_type"} {
  1372.     if {[$type ooplClass] == "" || [[$type ooplClass] isIDLSpecial]} {
  1373.         m4_error $E_ILL_DESTINATION [[$this ooplClass] get_obj_type] [[$this ooplClass] getName] [$type getPropertyValue class_type] [[$opposite ooplClass] getName]
  1374.         return
  1375.     }
  1376.     }
  1377.  
  1378.     set access [$this getPropertyValue assoc_access]
  1379.     set readAccess [$this genAccess [$this splitAccessMode $access r]]
  1380.     set writeAccess [$this genAccess [$this splitAccessMode $access w]]
  1381.     if {$readAccess != "Public" && $writeAccess != "Public" && $opposite == ""} {
  1382.     return
  1383.     }
  1384.  
  1385.     [IDGDataMgr::getMgr] addForward [$type getName]
  1386.  
  1387.     set sect [[IDGDataMgr::getMgr] getSect interface]
  1388.     $this genDescription $sect
  1389.  
  1390.     set oneway ""
  1391.     if {[$this getPropertyValue oneway] != "Off"} {
  1392.     set oneway "oneway "
  1393.     }
  1394.  
  1395.     set typeString [$type generate]
  1396.     set funcName [cap $name]
  1397.     if {[$this getMultiplicity] == "one"} {
  1398.     if {$readAccess == "Public"} {
  1399.         $sect append "$typeString get${funcName}();\n"
  1400.     }
  1401.     if {$writeAccess == "Public" || $opposite != ""} {
  1402.         $sect append "${oneway}void set${funcName}(in $typeString new${funcName});\n"
  1403.         if {![$this isMandatory]} {
  1404.         $sect append "${oneway}void remove${funcName}();\n"
  1405.         }
  1406.     }
  1407.     } else {
  1408.     # generate attribute if readable or someone else needs to write it
  1409.     regsub -all ":" $typeString "_" typeName
  1410.     set typeName "$typeName${funcName}Set"
  1411.     $sect append "typedef sequence<$typeString> $typeName;\n"
  1412.     if {$readAccess == "Public"} {
  1413.         $sect append "$typeName get${funcName}Set();\n"
  1414.     }
  1415.     if {$writeAccess == "Public" || $opposite != ""} {
  1416.         $sect append "${oneway}void add${funcName}(in $typeString new${funcName});\n"
  1417.         $sect append "${oneway}void remove${funcName}(in $typeString old${funcName});\n"
  1418.     }
  1419.     }
  1420.  
  1421.     $sect append "\n"
  1422. }
  1423.  
  1424. # Do not delete this line -- regeneration end marker
  1425.  
  1426. if [isCommand CMAssocAttr] {
  1427.     Class  IDGAssocAttrD : {IDGAssocAttr CMAssocAttr} {
  1428.     }
  1429. } else {
  1430.     Class IDGAssocAttrD : {IDGAssocAttr OPAssocAttr} {    
  1431.     }
  1432. }
  1433.  
  1434. global mostDerivedOOPL ; set mostDerivedOOPL(OPAssocAttr) IDGAssocAttrD
  1435.  
  1436. selfPromoter OPAssocAttr {this} {
  1437.     IDGAssocAttrD promote $this
  1438. }
  1439.  
  1440.  
  1441. #---------------------------------------------------------------------------
  1442. #      File:           @(#)idgdataatt.tcl    /main/titanic/2
  1443.  
  1444.  
  1445. Class IDGDataAttr : {IDGCmnAttr} {
  1446.     constructor
  1447.     method destructor
  1448.     method generate
  1449.     method genMember
  1450. }
  1451.  
  1452. constructor IDGDataAttr {class this name} {
  1453.     set this [IDGCmnAttr::constructor $class $this $name]
  1454.     # Start constructor user section
  1455.     # End constructor user section
  1456.     return $this
  1457. }
  1458.  
  1459. method IDGDataAttr::destructor {this} {
  1460.     # Start destructor user section
  1461.     # End destructor user section
  1462. }
  1463.  
  1464. method IDGDataAttr::generate {this} {
  1465.     set name [$this getName]
  1466.  
  1467.     set type [$this ooplType]
  1468.     set typeString [$type generate $name]
  1469.     set readAccess [$this splitAccessMode [$this getPropertyValue attrib_access] r]
  1470.     set writeAccess [$this splitAccessMode [$this getPropertyValue attrib_access] w]
  1471.     set const [$this getPropertyValue const]
  1472.     set initialValue [$this getInitialValue]
  1473.  
  1474.     if {$const == 1 && $initialValue == ""} {
  1475.     m4_error $E_NO_INIT_VALUE $name
  1476.     return
  1477.     }
  1478.  
  1479.     # only public attributes are exported
  1480.     if {$readAccess != "Public" && $readAccess != "" && $writeAccess != "Public" && $writeAccess != ""}  {
  1481.     return
  1482.     }
  1483.  
  1484.     set sect [[IDGDataMgr::getMgr] getSect interface]
  1485.     $this genDescription $sect
  1486.  
  1487.     if {$const != 1} {
  1488.     if {$writeAccess != "Public" && $writeAccess != ""} {
  1489.         set readonly "readonly "
  1490.     } else {
  1491.         set readonly ""
  1492.     }
  1493.     $sect append "${readonly}attribute $typeString;"
  1494.     } else {
  1495.     $sect append "const $typeString = $initialValue;"
  1496.     }
  1497.     $sect append "\n\n"
  1498. }
  1499.  
  1500. method IDGDataAttr::genMember {this {sect ""}} {
  1501.     if {[$this get_obj_type] == "constructor"} {
  1502.     return
  1503.     }
  1504.  
  1505.     if {$sect == ""} {
  1506.     set sect [[IDGDataMgr::getMgr] getSect interface]
  1507.     }
  1508.     $this genDescription $sect
  1509.  
  1510.     set name [$this getName]
  1511.     set type [$this ooplType]
  1512.     set typeString [$type generate $name]
  1513.     $sect append "$typeString;\n"
  1514. }
  1515.  
  1516. # Do not delete this line -- regeneration end marker
  1517.  
  1518. if [isCommand CMDataAttr] {
  1519.     Class  IDGDataAttrD : {IDGDataAttr CMDataAttr} {
  1520.     }
  1521. } else {
  1522.     Class IDGDataAttrD : {IDGDataAttr OPDataAttr} {    
  1523.     }
  1524. }
  1525.  
  1526. global mostDerivedOOPL ; set mostDerivedOOPL(OPDataAttr) IDGDataAttrD
  1527.  
  1528. selfPromoter OPDataAttr {this} {
  1529.     IDGDataAttrD promote $this
  1530. }
  1531.  
  1532.  
  1533. #---------------------------------------------------------------------------
  1534. #      File:           @(#)idglinkatt.tcl    /main/titanic/5
  1535.  
  1536.  
  1537. Class IDGLinkAttr : {IDGCmnAttr} {
  1538.     constructor
  1539.     method destructor
  1540.     method generate
  1541. }
  1542.  
  1543. constructor IDGLinkAttr {class this name} {
  1544.     set this [IDGCmnAttr::constructor $class $this $name]
  1545.     # Start constructor user section
  1546.     # End constructor user section
  1547.     return $this
  1548. }
  1549.  
  1550. method IDGLinkAttr::destructor {this} {
  1551.     # Start destructor user section
  1552.     # End destructor user section
  1553. }
  1554.  
  1555. method IDGLinkAttr::generate {this} {
  1556.     set name [$this getName]
  1557.     set type [$this ooplType]
  1558.     set opposite [$this opposite]
  1559.     if {[$type get_obj_type] != "base_type"} {
  1560.     if {[$type ooplClass] == "" || [[$type ooplClass] isIDLSpecial]} {
  1561.         set oppName ""
  1562.         if {$opposite != ""} {
  1563.         set oppName [[$opposite ooplClass] getName]
  1564.         }
  1565.         m4_error $E_ILL_DESTINATION [[$this ooplClass] get_obj_type] [[$this ooplClass] getName] [$type getPropertyValue class_type] $oppName
  1566.         return
  1567.     }
  1568.     }
  1569.  
  1570.     set access [$this getPropertyValue assoc_access]
  1571.     set readAccess [$this genAccess [$this splitAccessMode $access r]]
  1572.     set writeAccess [$this genAccess [$this splitAccessMode $access w]]
  1573.     if {$readAccess != "Public" && $writeAccess != "Public" && $opposite == ""} {
  1574.     return
  1575.     }
  1576.  
  1577.     [IDGDataMgr::getMgr] addForward [$type getName]
  1578.  
  1579.     set sect [[IDGDataMgr::getMgr] getSect interface]
  1580.     $this genDescription $sect
  1581.  
  1582.     set oneway ""
  1583.     if {[$this getPropertyValue oneway] != "Off"} {
  1584.     set oneway "oneway "
  1585.     }
  1586.  
  1587.     set assocTypeName [$type getName]
  1588.     set assocFuncName [cap $assocTypeName]
  1589.     set roleFuncName [cap $name]
  1590.     set funcName "${assocFuncName}Of${roleFuncName}"
  1591.     if {[$this getMultiplicity] == "one"} {
  1592.     if {$readAccess == "Public"} {
  1593.         $sect append "$assocTypeName get${funcName}();\n"
  1594.     }
  1595.     if {$writeAccess == "Public" || $opposite != ""} {
  1596.         $sect append "${oneway}void set${funcName}(in $assocTypeName new${funcName});\n"
  1597.         if {![$this isMandatory]} {
  1598.         $sect append "${oneway}void remove${funcName}();\n"
  1599.         }
  1600.     }
  1601.     } else {
  1602.     # generate attribute if readable or someone else needs to write it
  1603.     $sect append "typedef sequence<${assocTypeName}> ${funcName}Set;\n"
  1604.     if {$readAccess == "Public"} {
  1605.         $sect append "${funcName}Set get${funcName}Set();\n"
  1606.     }
  1607.     if {$writeAccess == "Public" || $opposite != ""} {
  1608.         $sect append "${oneway}void add${funcName}(in $assocTypeName new${funcName});\n"
  1609.         $sect append "${oneway}void remove${funcName}(in $assocTypeName old${funcName});\n"
  1610.     }
  1611.     }
  1612.  
  1613.     $sect append "\n"
  1614. }
  1615.  
  1616. # Do not delete this line -- regeneration end marker
  1617.  
  1618. if [isCommand CMLinkAttr] {
  1619.     Class  IDGLinkAttrD : {IDGLinkAttr CMLinkAttr} {
  1620.     }
  1621. } else {
  1622.     Class IDGLinkAttrD : {IDGLinkAttr OPLinkAttr} {    
  1623.     }
  1624. }
  1625.  
  1626. global mostDerivedOOPL ; set mostDerivedOOPL(OPLinkAttr) IDGLinkAttrD
  1627.  
  1628. selfPromoter OPLinkAttr {this} {
  1629.     IDGLinkAttrD promote $this
  1630. }
  1631.  
  1632.  
  1633. #---------------------------------------------------------------------------
  1634. #      File:           @(#)idgqualass.tcl    /main/titanic/5
  1635.  
  1636.  
  1637. Class IDGQualAssocAttr : {IDGCmnAttr} {
  1638.     constructor
  1639.     method destructor
  1640.     method generate
  1641. }
  1642.  
  1643. constructor IDGQualAssocAttr {class this name} {
  1644.     set this [IDGCmnAttr::constructor $class $this $name]
  1645.     # Start constructor user section
  1646.     # End constructor user section
  1647.     return $this
  1648. }
  1649.  
  1650. method IDGQualAssocAttr::destructor {this} {
  1651.     # Start destructor user section
  1652.     # End destructor user section
  1653. }
  1654.  
  1655. method IDGQualAssocAttr::generate {this} {
  1656.     set name [$this getName]
  1657.     set type [$this ooplType]
  1658.     set opposite [$this opposite]
  1659.     if {[$type get_obj_type] != "base_type"} {
  1660.     if {[$type ooplClass] == "" || [[$type ooplClass] isIDLSpecial]} {
  1661.         m4_error $E_ILL_DESTINATION [[$this ooplClass] get_obj_type] [[$this ooplClass] getName] [$type getPropertyValue class_type] [[$opposite ooplClass] getName]
  1662.         return
  1663.     }
  1664.     }
  1665.  
  1666.     set access [$this getPropertyValue assoc_access]
  1667.     set readAccess [$this genAccess [$this splitAccessMode $access r]]
  1668.     set writeAccess [$this genAccess [$this splitAccessMode $access w]]
  1669.     if {$readAccess != "Public" && $writeAccess != "Public" && $opposite == ""} {
  1670.     return
  1671.     }
  1672.  
  1673.     [IDGDataMgr::getMgr] addForward [$type getName]
  1674.  
  1675.     set sect [[IDGDataMgr::getMgr] getSect interface]
  1676.     $this genDescription $sect
  1677.  
  1678.     set oneway ""
  1679.     if {[$this getPropertyValue oneway] != "Off"} {
  1680.     set oneway "oneway "
  1681.     }
  1682.  
  1683.     set funcName [cap $name]
  1684.     set typeString [$type generate]
  1685.     set key [$this qualifier]
  1686.     set keyName [$key getName]
  1687.     set keyType [[$key ooplType] generate]
  1688.     if {[$this getMultiplicity] == "one"} {
  1689.     # generate attribute if readable or someone else needs to write it
  1690.     if {$readAccess == "Public"} {
  1691.         $sect append "$typeString get${funcName}(in $keyType $keyName);\n"
  1692.     }
  1693.     if {$writeAccess == "Public" || $opposite != ""} {
  1694.         $sect append "${oneway}void set${funcName}(in $keyType $keyName, in $typeString new$funcName);\n"
  1695.         if {![$this isMandatory]} {
  1696.         $sect append "${oneway}void remove${funcName}(in $keyType $keyName);\n"
  1697.         }
  1698.     }
  1699.     } else {
  1700.     # generate attribute if readable or someone else needs to write it
  1701.     regsub -all ":" $typeString "_" typeName
  1702.     set typeName "$typeName${funcName}Set"
  1703.     $sect append "typedef sequence<$typeString> $typeName;\n"
  1704.     if {$readAccess == "Public"} {
  1705.         $sect append "$typeName get${funcName}Set(in $keyType $keyName);\n"
  1706.     }
  1707.     if {$writeAccess == "Public" || $opposite != ""} {
  1708.         $sect append "${oneway}void add${funcName}(in $keyType $keyName, in $typeString new${funcName});\n"
  1709.         $sect append "${oneway}void remove${funcName}(in $keyType $keyName, in $typeString old${funcName});\n"
  1710.     }
  1711.     }
  1712.  
  1713.     $sect append "\n"
  1714. }
  1715.  
  1716. # Do not delete this line -- regeneration end marker
  1717.  
  1718. if [isCommand CMQualAssocAttr] {
  1719.     Class  IDGQualAssocAttrD : {IDGQualAssocAttr CMQualAssocAttr} {
  1720.     }
  1721. } else {
  1722.     Class IDGQualAssocAttrD : {IDGQualAssocAttr OPQualAssocAttr} {    
  1723.     }
  1724. }
  1725.  
  1726. global mostDerivedOOPL ; set mostDerivedOOPL(OPQualAssocAttr) IDGQualAssocAttrD
  1727.  
  1728. selfPromoter OPQualAssocAttr {this} {
  1729.     IDGQualAssocAttrD promote $this
  1730. }
  1731.  
  1732.  
  1733. #---------------------------------------------------------------------------
  1734. #      File:           @(#)idgquallin.tcl    /main/titanic/7
  1735.  
  1736.  
  1737. Class IDGQualLinkAttr : {IDGCmnAttr} {
  1738.     constructor
  1739.     method destructor
  1740.     method generate
  1741. }
  1742.  
  1743. constructor IDGQualLinkAttr {class this name} {
  1744.     set this [IDGCmnAttr::constructor $class $this $name]
  1745.     # Start constructor user section
  1746.     # End constructor user section
  1747.     return $this
  1748. }
  1749.  
  1750. method IDGQualLinkAttr::destructor {this} {
  1751.     # Start destructor user section
  1752.     # End destructor user section
  1753. }
  1754.  
  1755. method IDGQualLinkAttr::generate {this} {
  1756.     set name [$this getName]
  1757.     set type [$this ooplType]
  1758.     set opposite [$this opposite]
  1759.     if {[$type get_obj_type] != "base_type"} {
  1760.     if {[$type ooplClass] == "" || [[$type ooplClass] isIDLSpecial]} {
  1761.         set oppName ""
  1762.         if {$opposite != ""} {
  1763.         set oppName [[$opposite ooplClass] getName]
  1764.         }
  1765.         m4_error $E_ILL_DESTINATION [[$this ooplClass] get_obj_type] [[$this ooplClass] getName] [$type getPropertyValue class_type] $oppName
  1766.         return
  1767.     }
  1768.     }
  1769.  
  1770.     set access [$this getPropertyValue assoc_access]
  1771.     set readAccess [$this genAccess [$this splitAccessMode $access r]]
  1772.     set writeAccess [$this genAccess [$this splitAccessMode $access w]]
  1773.     if {$readAccess != "Public" && $writeAccess != "Public" && $opposite == ""} {
  1774.     return
  1775.     }
  1776.  
  1777.     [IDGDataMgr::getMgr] addForward [$type getName]
  1778.  
  1779.     set sect [[IDGDataMgr::getMgr] getSect interface]
  1780.     $this genDescription $sect
  1781.  
  1782.     set oneway ""
  1783.     if {[$this getPropertyValue oneway] != "Off"} {
  1784.     set oneway "oneway "
  1785.     }
  1786.  
  1787.     set assocTypeName [$type getName]
  1788.     set assocFuncName [cap $assocTypeName]
  1789.     set roleFuncName [cap $name]
  1790.     set funcName "${assocFuncName}Of${roleFuncName}"
  1791.     set key [$this qualifier]
  1792.     set keyName [$key getName]
  1793.     set keyType [[$key ooplType] generate]
  1794.     if {[$this getMultiplicity] == "one"} {
  1795.     if {$readAccess == "Public"} {
  1796.         $sect append "$assocTypeName get${funcName}(in $keyType $keyName);\n"
  1797.     }
  1798.     if {$writeAccess == "Public" || $opposite != ""} {
  1799.         $sect append "${oneway}void set${funcName}(in $keyType $keyName, in $assocTypeName new${funcName});\n"
  1800.         if {![$this isMandatory]} {
  1801.         $sect append "${oneway}void remove${funcName}(in $keyType $keyName);\n"
  1802.         }
  1803.     }
  1804.     } else {
  1805.     # generate attribute if readable or someone else needs to write it
  1806.     $sect append "typedef sequence<${assocTypeName}> ${funcName}Set;\n"
  1807.     if {$readAccess == "Public"} {
  1808.         $sect append "${funcName}Set get${funcName}Set(in $keyType $keyName);\n"
  1809.     }
  1810.     if {$writeAccess == "Public" || $opposite != ""} {
  1811.         $sect append "${oneway}void add${funcName}(in $keyType $keyName, in $assocTypeName new${funcName});\n"
  1812.         $sect append "${oneway}void remove${funcName}(in $keyType $keyName, in $assocTypeName old${funcName});\n"
  1813.     }
  1814.     }
  1815.  
  1816.     $sect append "\n"
  1817. }
  1818.  
  1819. # Do not delete this line -- regeneration end marker
  1820.  
  1821. if [isCommand CMQualLinkAttr] {
  1822.     Class  IDGQualLinkAttrD : {IDGQualLinkAttr CMQualLinkAttr} {
  1823.     }
  1824. } else {
  1825.     Class IDGQualLinkAttrD : {IDGQualLinkAttr OPQualLinkAttr} {    
  1826.     }
  1827. }
  1828.  
  1829. global mostDerivedOOPL ; set mostDerivedOOPL(OPQualLinkAttr) IDGQualLinkAttrD
  1830.  
  1831. selfPromoter OPQualLinkAttr {this} {
  1832.     IDGQualLinkAttrD promote $this
  1833. }
  1834.  
  1835.  
  1836. #---------------------------------------------------------------------------
  1837. #      File:           @(#)idgreverse.tcl    /main/titanic/2
  1838.  
  1839.  
  1840. Class IDGReverseLinkAttr : {IDGCmnAttr} {
  1841.     constructor
  1842.     method destructor
  1843.     method generate
  1844. }
  1845.  
  1846. constructor IDGReverseLinkAttr {class this name} {
  1847.     set this [IDGCmnAttr::constructor $class $this $name]
  1848.     # Start constructor user section
  1849.     # End constructor user section
  1850.     return $this
  1851. }
  1852.  
  1853. method IDGReverseLinkAttr::destructor {this} {
  1854.     # Start destructor user section
  1855.     # End destructor user section
  1856. }
  1857.  
  1858. method IDGReverseLinkAttr::generate {this} {
  1859.     set access [$this getPropertyValue assoc_access]
  1860.     set readAccess [$this genAccess [$this splitAccessMode $access r]]
  1861.     if {$readAccess != "Public"} {
  1862.     return
  1863.     }
  1864.  
  1865.     set type [$this ooplType]
  1866.     [IDGDataMgr::getMgr] addForward [$type getName]
  1867.  
  1868.     set sect [[IDGDataMgr::getMgr] getSect interface]
  1869.     $this genDescription $sect
  1870.  
  1871.     # generate attribute if readable or someone else needs to write it
  1872.     set typeString [$type generate]
  1873.     set name [$this getName]
  1874.     $sect append "$typeString get[cap $name]();\n\n"
  1875. }
  1876.  
  1877. # Do not delete this line -- regeneration end marker
  1878.  
  1879. if [isCommand CMReverseLinkAttr] {
  1880.     Class  IDGReverseLinkAttrD : {IDGReverseLinkAttr CMReverseLinkAttr} {
  1881.     }
  1882. } else {
  1883.     Class IDGReverseLinkAttrD : {IDGReverseLinkAttr OPReverseLinkAttr} {    
  1884.     }
  1885. }
  1886.  
  1887. global mostDerivedOOPL ; set mostDerivedOOPL(OPReverseLinkAttr) IDGReverseLinkAttrD
  1888.  
  1889. selfPromoter OPReverseLinkAttr {this} {
  1890.     IDGReverseLinkAttrD promote $this
  1891. }
  1892.