home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / vatarget.tcl < prev    next >
Text File  |  1997-12-01  |  18KB  |  663 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            : vatarget.tcl
  17. #       Author          : 
  18. #       Original date   : November 1997
  19. #       Description     : Classes for code generation
  20. #
  21. #---------------------------------------------------------------------------
  22.  
  23. #---------------------------------------------------------------------------
  24. #      File:           @(#)vacomment.tcl    /main/titanic/1
  25. #---------------------------------------------------------------------------
  26.  
  27. # Start user added include file section
  28. # End user added include file section
  29.  
  30.  
  31. Class VAComment : {GCObject} {
  32.     constructor
  33.     method destructor
  34.     method generate
  35.     attribute comment
  36. }
  37.  
  38. constructor VAComment {class this} {
  39.     set this [GCObject::constructor $class $this]
  40.     # Start constructor user section
  41.     # End constructor user section
  42.     return $this
  43. }
  44.  
  45. method VAComment::destructor {this} {
  46.     # Start destructor user section
  47.     # End destructor user section
  48. }
  49.  
  50. method VAComment::generate {this section} {
  51.         if { [string length [$this comment]] > 0 } {
  52.                 set restComment [$this comment]
  53.                 set newlinePos [string first "\n" $restComment ]
  54.                 while {$newlinePos != -1} {
  55.                         set thisline [string range $restComment 0 [expr $newlinePos - 1]]
  56.                         set restComment \
  57.                                 [string range $restComment [expr $newlinePos + 1] end]
  58.                         set newlinePos [string first "\n" $restComment ]
  59.                         $section append "// $thisline\n"
  60.                 }
  61.                 $section append "// $restComment\n"
  62.         }
  63. }
  64.  
  65. # Do not delete this line -- regeneration end marker
  66.  
  67. #---------------------------------------------------------------------------
  68. #      File:           @(#)vafeature.tcl    /main/titanic/1
  69. #---------------------------------------------------------------------------
  70.  
  71. # Start user added include file section
  72. # End user added include file section
  73.  
  74.  
  75. Class VAFeature : {GCObject} {
  76.     constructor
  77.     method destructor
  78.     attribute name
  79. }
  80.  
  81. constructor VAFeature {class this} {
  82.     set this [GCObject::constructor $class $this]
  83.     # Start constructor user section
  84.     # End constructor user section
  85.     return $this
  86. }
  87.  
  88. method VAFeature::destructor {this} {
  89.     # Start destructor user section
  90.     # End destructor user section
  91. }
  92.  
  93. # Do not delete this line -- regeneration end marker
  94.  
  95. #---------------------------------------------------------------------------
  96. #      File:           @(#)vaelement.tcl    /main/titanic/3
  97. #---------------------------------------------------------------------------
  98.  
  99. # Start user added include file section
  100. # End user added include file section
  101.  
  102.  
  103. Class VAElement : {GCObject} {
  104.     constructor
  105.     method destructor
  106.     method generateBegin
  107.     method generateBeginSub
  108.     method generateMiddle
  109.     method generateEnd
  110.     method generate
  111.     attribute name
  112.     attribute description
  113.     attribute type
  114.     attribute comment
  115. }
  116.  
  117. constructor VAElement {class this} {
  118.     set this [GCObject::constructor $class $this]
  119.     $this type "none"
  120.     # Start constructor user section
  121.     # End constructor user section
  122.     return $this
  123. }
  124.  
  125. method VAElement::destructor {this} {
  126.     # Start destructor user section
  127.     # End destructor user section
  128. }
  129.  
  130. method VAElement::generateBegin {this section} {
  131. }
  132.  
  133. method VAElement::generateBeginSub {this section} {
  134. }
  135.  
  136. method VAElement::generateMiddle {this section} {
  137. }
  138.  
  139. method VAElement::generateEnd {this section} {
  140. }
  141.  
  142. method VAElement::generate {this section} {
  143.         if {[$this comment] != ""} {
  144.               [$this comment] generate $section
  145.         }
  146.         $section append "//VBBegin[$this type]Info: [$this name]"
  147.         if {[$this description] != ""} {
  148.                 $section append ", \"[$this description]\""
  149.         }
  150.         $section append "\n"
  151.         $this generateBegin $section
  152.         $this generateBeginSub $section
  153.            $section append "//VBPartDataFile: [$this name].vbb\n"
  154.  
  155.         $this generateMiddle $section
  156.         $this generateEnd $section
  157.         $section append "//VBEnd[$this type]Info: [$this name]\n"
  158. }
  159.  
  160. # Do not delete this line -- regeneration end marker
  161.  
  162. #---------------------------------------------------------------------------
  163. #      File:           @(#)vaparts.tcl    /main/titanic/2
  164. #---------------------------------------------------------------------------
  165.  
  166. # Start user added include file section
  167. # End user added include file section
  168.  
  169.  
  170. Class VAParts : {GCObject} {
  171.     constructor
  172.     method destructor
  173.     method generate
  174.     method getCls
  175.     method setCls
  176.     method removeCls
  177.     method getEnum
  178.     method setEnum
  179.     method removeEnum
  180.     method getTypedef
  181.     method setTypedef
  182.     method removeTypedef
  183.     attribute name
  184.     attribute cls
  185.     attribute enum
  186.     attribute typedef
  187. }
  188.  
  189. constructor VAParts {class this} {
  190.     set this [GCObject::constructor $class $this]
  191.     $this cls [Dictionary new]
  192.     $this enum [Dictionary new]
  193.     $this typedef [Dictionary new]
  194.     # Start constructor user section
  195.     # End constructor user section
  196.     return $this
  197. }
  198.  
  199. method VAParts::destructor {this} {
  200.     # Start destructor user section
  201.     # End destructor user section
  202. }
  203.  
  204. method VAParts::generate {this typeToClassDict} {
  205.         $typeToClassDict foreach ooplclass fileDict {
  206.         if {[[$this cls] exists [$ooplclass getName]]} {
  207.                        set vbefile [TextSection new]
  208.                        [[$this cls] set [$ooplclass getName]] generate $vbefile
  209.                        $fileDict set "vbe" $vbefile
  210.         } else {
  211.             if {[[$this enum] exists [$ooplclass getName]]} {
  212.                            set vbefile [TextSection new]
  213.                            [[$this enum] set [$ooplclass getName]] generate $vbefile
  214.                            $fileDict set "vbe" $vbefile
  215.             } else {
  216.                 if {[[$this typedef] exists [$ooplclass getName]]} {
  217.                                set vbefile [TextSection new]
  218.                                [[$this typedef] set [$ooplclass getName]] generate $vbefile
  219.                                $fileDict set "vbe" $vbefile
  220.                 }
  221.             }
  222.         }
  223.         }
  224. }
  225.  
  226. # Do not delete this line -- regeneration end marker
  227.  
  228. method VAParts::getCls {this name} {
  229.     return [[$this cls] set $name]
  230. }
  231.  
  232. method VAParts::setCls {this name newCls} {
  233.     [$this cls] set $name $newCls
  234. }
  235.  
  236. method VAParts::removeCls {this name} {
  237.     [$this cls] unset $name
  238. }
  239.  
  240. method VAParts::getEnum {this name} {
  241.     return [[$this enum] set $name]
  242. }
  243.  
  244. method VAParts::setEnum {this name newEnum} {
  245.     [$this enum] set $name $newEnum
  246. }
  247.  
  248. method VAParts::removeEnum {this name} {
  249.     [$this enum] unset $name
  250. }
  251.  
  252. method VAParts::getTypedef {this name} {
  253.     return [[$this typedef] set $name]
  254. }
  255.  
  256. method VAParts::setTypedef {this name newTypedef} {
  257.     [$this typedef] set $name $newTypedef
  258. }
  259.  
  260. method VAParts::removeTypedef {this name} {
  261.     [$this typedef] unset $name
  262. }
  263.  
  264. #---------------------------------------------------------------------------
  265. #      File:           @(#)vasubfeatu.tcl    /main/titanic/1
  266. #---------------------------------------------------------------------------
  267.  
  268. # Start user added include file section
  269. # End user added include file section
  270.  
  271.  
  272. Class VASubFeature : {VAFeature} {
  273.     constructor
  274.     method destructor
  275.     method generate
  276.     method generateBegin
  277.     method generateEnd
  278.     attribute description
  279.     attribute preferred
  280.     attribute noConnect
  281.     attribute comment
  282. }
  283.  
  284. constructor VASubFeature {class this} {
  285.     set this [VAFeature::constructor $class $this]
  286.     # Start constructor user section
  287.     # End constructor user section
  288.     return $this
  289. }
  290.  
  291. method VASubFeature::destructor {this} {
  292.     # Start destructor user section
  293.     # End destructor user section
  294.     $this VAFeature::destructor
  295. }
  296.  
  297. method VASubFeature::generate {this section} {
  298.     $this generateBegin $section
  299.     $this generateEnd $section
  300. }
  301.  
  302. method VASubFeature::generateBegin {this section} {
  303.         if {[$this comment] != ""} {
  304.               [$this comment] generate $section
  305.         }
  306.         $section append "//VB[$this ftype]:  [$this name]"
  307.         $section append ","
  308.         if {[$this description] != ""} {
  309.                 $section append " \"[$this description]\""
  310.         }
  311.         $section append ","
  312. }
  313.  
  314. method VASubFeature::generateEnd {this section} {
  315.     $section append "\n"
  316. }
  317.  
  318. # Do not delete this line -- regeneration end marker
  319.  
  320. #---------------------------------------------------------------------------
  321. #      File:           @(#)vaattribut.tcl    /main/titanic/2
  322. #---------------------------------------------------------------------------
  323.  
  324. # Start user added include file section
  325. # End user added include file section
  326.  
  327.  
  328. Class VAAttribute : {VASubFeature} {
  329.     constructor
  330.     method destructor
  331.     method generateEnd
  332.     attribute ftype
  333.     attribute type
  334.     attribute queryMember
  335.     attribute setMember
  336.     attribute noSetting
  337. }
  338.  
  339. constructor VAAttribute {class this} {
  340.     set this [VASubFeature::constructor $class $this]
  341.     $this ftype "Attribute"
  342.     # Start constructor user section
  343.     # End constructor user section
  344.     return $this
  345. }
  346.  
  347. method VAAttribute::destructor {this} {
  348.     # Start destructor user section
  349.     # End destructor user section
  350.     $this VASubFeature::destructor
  351. }
  352.  
  353. method VAAttribute::generateEnd {this section} {
  354.         $section append " [$this type], "
  355.         $section append "[$this queryMember]"
  356.         if {[$this noConnect] == "1" || [$this noSetting] == "1" || [$this setMember] != ""} {
  357.         $section append ","
  358.     }
  359.     if {[$this setMember] != ""} {
  360.         $section append " [$this setMember]"
  361.         }
  362.         if {[$this noConnect] == "1" || [$this noSetting] == "1"} {
  363.                 $section append ",,"
  364.         }
  365.         if {[$this noSetting] == "1"} {
  366.                 $section append " NOSETTING"
  367.         }
  368.         if {[$this noConnect] == "1"} {
  369.                 $section append " NOCONNECT"
  370.         }
  371.         $section append "\n"
  372. }
  373.  
  374. # Do not delete this line -- regeneration end marker
  375.  
  376. #---------------------------------------------------------------------------
  377. #      File:           @(#)vaaction.tcl    /main/titanic/1
  378. #---------------------------------------------------------------------------
  379.  
  380. # Start user added include file section
  381. # End user added include file section
  382.  
  383.  
  384. Class VAAction : {VASubFeature} {
  385.     constructor
  386.     method destructor
  387.     method generateEnd
  388.     attribute ftype
  389.     attribute returnType
  390.     attribute actionMember
  391. }
  392.  
  393. constructor VAAction {class this} {
  394.     set this [VASubFeature::constructor $class $this]
  395.     $this ftype "Action"
  396.     # Start constructor user section
  397.     # End constructor user section
  398.     return $this
  399. }
  400.  
  401. method VAAction::destructor {this} {
  402.     # Start destructor user section
  403.     # End destructor user section
  404.     $this VASubFeature::destructor
  405. }
  406.  
  407. method VAAction::generateEnd {this section} {
  408.         $section append "[$this returnType], "
  409.         $section append "[$this actionMember]"
  410.         if {[$this noConnect] == "1"} {
  411.                 $section append ", NOCONNECT"
  412.         }
  413.         $section append "\n"
  414. }
  415.  
  416. # Do not delete this line -- regeneration end marker
  417.  
  418. #---------------------------------------------------------------------------
  419. #      File:           @(#)vaenum.tcl    /main/titanic/1
  420. #---------------------------------------------------------------------------
  421.  
  422. # Start user added include file section
  423. # End user added include file section
  424.  
  425.  
  426. Class VAEnum : {VAFeature} {
  427.     constructor
  428.     method destructor
  429.     method generate
  430.     attribute value
  431. }
  432.  
  433. constructor VAEnum {class this} {
  434.     set this [VAFeature::constructor $class $this]
  435.     # Start constructor user section
  436.     # End constructor user section
  437.     return $this
  438. }
  439.  
  440. method VAEnum::destructor {this} {
  441.     # Start destructor user section
  442.     # End destructor user section
  443.     $this VAFeature::destructor
  444. }
  445.  
  446. method VAEnum::generate {this section} {
  447.         $section append "[$this name]"
  448.     if {[$this value] != ""} {
  449.             $section append " = [$this value]"
  450.     }
  451. }
  452.  
  453. # Do not delete this line -- regeneration end marker
  454.  
  455. #---------------------------------------------------------------------------
  456. #      File:           @(#)vatypedef.tcl    /main/titanic/1
  457. #---------------------------------------------------------------------------
  458.  
  459. # Start user added include file section
  460. # End user added include file section
  461.  
  462.  
  463. Class VATypeDef : {VAElement} {
  464.     constructor
  465.     method destructor
  466.     attribute type
  467. }
  468.  
  469. constructor VATypeDef {class this} {
  470.     set this [VAElement::constructor $class $this]
  471.     $this type "Typedef"
  472.     # Start constructor user section
  473.     # End constructor user section
  474.     return $this
  475. }
  476.  
  477. method VATypeDef::destructor {this} {
  478.     # Start destructor user section
  479.     # End destructor user section
  480.     $this VAElement::destructor
  481. }
  482.  
  483. # Do not delete this line -- regeneration end marker
  484.  
  485. #---------------------------------------------------------------------------
  486. #      File:           @(#)vaenums.tcl    /main/titanic/1
  487. #---------------------------------------------------------------------------
  488.  
  489. # Start user added include file section
  490. # End user added include file section
  491.  
  492.  
  493. Class VAEnums : {VAElement} {
  494.     constructor
  495.     method destructor
  496.     method generateMiddle
  497.     method addEnum
  498.     method removeEnum
  499.     attribute type
  500.     attribute enumSet
  501. }
  502.  
  503. constructor VAEnums {class this} {
  504.     set this [VAElement::constructor $class $this]
  505.     $this type "Enum"
  506.     $this enumSet [List new]
  507.     # Start constructor user section
  508.     # End constructor user section
  509.     return $this
  510. }
  511.  
  512. method VAEnums::destructor {this} {
  513.     # Start destructor user section
  514.     # End destructor user section
  515.     $this VAElement::destructor
  516. }
  517.  
  518. method VAEnums::generateMiddle {this section} {
  519.         $section append "//VBEnumerators:  "
  520.         set first 1
  521.         [$this enumSet] foreach enum {
  522.                 if {$first} {
  523.                         set first 0
  524.                 } else {
  525.                         $section append "\n//VB:\t\t, "
  526.                 }
  527.                 $enum generate $section
  528.         }
  529.         $section append "\n"
  530. }
  531.  
  532. # Do not delete this line -- regeneration end marker
  533.  
  534. method VAEnums::addEnum {this newEnum} {
  535.     [$this enumSet] append $newEnum
  536.  
  537. }
  538.  
  539. method VAEnums::removeEnum {this oldEnum} {
  540.     [$this enumSet] removeValue $oldEnum
  541. }
  542.  
  543. #---------------------------------------------------------------------------
  544. #      File:           @(#)vaclass.tcl    /main/titanic/1
  545. #---------------------------------------------------------------------------
  546.  
  547. # Start user added include file section
  548. # End user added include file section
  549.  
  550.  
  551. Class VAClass : {VAElement} {
  552.     constructor
  553.     method destructor
  554.     method generateBegin
  555.     method generateMiddle
  556.     method addAction
  557.     method removeAction
  558.     method addAttribute
  559.     method removeAttribute
  560.     attribute parentName
  561.     attribute iconResourceId
  562.     attribute resourceDll
  563.     attribute abstract
  564.     attribute constraints
  565.     attribute constructor
  566.     attribute type
  567.     attribute actionSet
  568.     attribute attributeSet
  569. }
  570.  
  571. constructor VAClass {class this} {
  572.     set this [VAElement::constructor $class $this]
  573.     $this type "Part"
  574.     $this actionSet [List new]
  575.     $this attributeSet [List new]
  576.     # Start constructor user section
  577.     # End constructor user section
  578.     return $this
  579. }
  580.  
  581. method VAClass::destructor {this} {
  582.     # Start destructor user section
  583.     # End destructor user section
  584.     $this VAElement::destructor
  585. }
  586.  
  587. method VAClass::generateBegin {this section} {
  588.     if {[$this parentName] != "" } {    
  589.             $section append "//VBParent: [$this parentName]\n"
  590.     }
  591. }
  592.  
  593. method VAClass::generateMiddle {this section} {
  594.         $section append "//VBComposerInfo: class"
  595.     if {[$this iconResourceId] != ""} {
  596.                 $section append ", [$this iconResourceId], [$this resourceDll]"
  597.         }
  598.     if {[$this abstract] == "1"} {
  599.                 $section append ", abstract"
  600.         }
  601.         $section append "\n"
  602.     if {[$this constraints] != ""} {
  603.                 $section append "//VBConstraints: [$this constraints]\n"
  604.         }
  605.     if {[$this constructor] != ""} {
  606.                 $section append "//VBConstructor: [$this constructor]\n"
  607.         }
  608.         [$this actionSet] foreach action {
  609.         $action generate $section
  610.     }
  611.         [$this attributeSet] foreach attribute {
  612.         $attribute generate $section
  613.     }
  614.         set first 1
  615.     set new_section [TextSection new]
  616.         [$this actionSet] foreach action {
  617.         if {[$action preferred] == "1"} {
  618.                     if {$first} {
  619.                                 set first 0
  620.                     } else {
  621.                             $new_section append "\n//VB:\t\t, "
  622.             }
  623.             $new_section append "[$action name]"
  624.         }
  625.     }
  626.         [$this attributeSet] foreach attribute {
  627.         if {[$attribute preferred] == "1"} {
  628.                     if {$first} {
  629.                                 set first 0
  630.                     } else {
  631.                             $new_section append "\n//VB:\t\t, "
  632.             }
  633.             $new_section append "[$attribute name]"
  634.         }
  635.     }
  636.     if {!$first} {
  637.         $section append "//VBPreferredFeatures:   "
  638.         $section appendSect $new_section
  639.         $section append "\n"
  640.     }
  641. }
  642.  
  643. # Do not delete this line -- regeneration end marker
  644.  
  645. method VAClass::addAction {this newAction} {
  646.     [$this actionSet] append $newAction
  647.  
  648. }
  649.  
  650. method VAClass::removeAction {this oldAction} {
  651.     [$this actionSet] removeValue $oldAction
  652. }
  653.  
  654. method VAClass::addAttribute {this newAttribute} {
  655.     [$this attributeSet] append $newAttribute
  656.  
  657. }
  658.  
  659. method VAClass::removeAttribute {this oldAttribute} {
  660.     [$this attributeSet] removeValue $oldAttribute
  661. }
  662.  
  663.