home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / delphitgt.tcl < prev    next >
Text File  |  1997-11-07  |  53KB  |  2,122 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            : delphitgt.tcl
  17. #       Author          : 
  18. #       Original date   : November 1997
  19. #       Description     : Classes for code generation
  20. #
  21. #---------------------------------------------------------------------------
  22.  
  23. #---------------------------------------------------------------------------
  24. #      File:           @(#)dpargument.tcl    /main/titanic/3
  25. #---------------------------------------------------------------------------
  26.  
  27. # Start user added include file section
  28. # End user added include file section
  29.  
  30.  
  31. Class DPArgument : {GCObject} {
  32.     constructor
  33.     method destructor
  34.     method generate
  35.     attribute name
  36.     attribute passedBy
  37.     attribute type
  38. }
  39.  
  40. constructor DPArgument {class this type} {
  41.     set this [GCObject::constructor $class $this]
  42.     $this type $type
  43.     # Start constructor user section
  44.     # End constructor user section
  45.     return $this
  46. }
  47.  
  48. method DPArgument::destructor {this} {
  49.     # Start destructor user section
  50.     # End destructor user section
  51. }
  52.  
  53. method DPArgument::generate {this whole unit} {
  54.     switch [$this passedBy] {
  55.         "Variable" {
  56.             $whole append "var "
  57.         }
  58.         "Constant" {
  59.             $whole append "const "
  60.         }
  61.         "Out" {
  62.             $whole append "out "
  63.         }
  64.     }
  65.     $whole append "[$this name]"
  66.     if {[[$this type] name] != ""} {
  67.         $whole append ": "
  68.     }
  69.     [$this type] generate $whole $unit
  70. }
  71.  
  72. # Do not delete this line -- regeneration end marker
  73.  
  74. #---------------------------------------------------------------------------
  75. #      File:           @(#)dpcomment.tcl    /main/titanic/1
  76. #---------------------------------------------------------------------------
  77.  
  78. # Start user added include file section
  79. # End user added include file section
  80.  
  81.  
  82. Class DPComment : {GCObject} {
  83.     constructor
  84.     method destructor
  85.     method generate
  86.     attribute comment
  87. }
  88.  
  89. constructor DPComment {class this} {
  90.     set this [GCObject::constructor $class $this]
  91.     # Start constructor user section
  92.     # End constructor user section
  93.     return $this
  94. }
  95.  
  96. method DPComment::destructor {this} {
  97.     # Start destructor user section
  98.     # End destructor user section
  99. }
  100.  
  101. method DPComment::generate {this whole} {
  102.    if { [string length [$this comment]] > 0 } {
  103.       set restComment [$this comment]
  104.       set newlinePos [string first "\n" $restComment ]
  105.       while {$newlinePos != -1} {
  106.          set thisline [string range $restComment 0 [expr $newlinePos - 1]]
  107.          set restComment \
  108.          [string range $restComment [expr $newlinePos + 1] end]
  109.          set newlinePos [string first "\n" $restComment ]
  110.          $whole append "// $thisline\n"
  111.       }
  112.       $whole append "// $restComment\n"
  113.    }
  114.  
  115. }
  116.  
  117. # Do not delete this line -- regeneration end marker
  118.  
  119. #---------------------------------------------------------------------------
  120. #      File:           @(#)dpcontrole.tcl    /main/titanic/2
  121. #---------------------------------------------------------------------------
  122.  
  123. # Start user added include file section
  124. # End user added include file section
  125.  
  126.  
  127. Class DPControlEvent : {GCObject} {
  128.     constructor
  129.     method destructor
  130.     method generate
  131.     attribute name
  132.     attribute method
  133. }
  134.  
  135. constructor DPControlEvent {class this method} {
  136.     set this [GCObject::constructor $class $this]
  137.     $this method $method
  138.     # Start constructor user section
  139.     # End constructor user section
  140.     return $this
  141. }
  142.  
  143. method DPControlEvent::destructor {this} {
  144.     # Start destructor user section
  145.     # End destructor user section
  146. }
  147.  
  148. method DPControlEvent::generate {this section} {
  149.     if {![regexp ^(after|before) [string tolower [$this name]]]} {
  150.         $section append "On"
  151.     }
  152.     $section append [$this name]
  153.     $section append " = "
  154.     $section append [[$this method] name]
  155.     $section append "\n"
  156. }
  157.  
  158. # Do not delete this line -- regeneration end marker
  159.  
  160. #---------------------------------------------------------------------------
  161. #      File:           @(#)dpcookie.tcl    /main/titanic/7
  162. #---------------------------------------------------------------------------
  163.  
  164. # Start user added include file section
  165. # End user added include file section
  166.  
  167.  
  168. Class DPCookie : {GCObject} {
  169.     constructor
  170.     method destructor
  171. }
  172.  
  173. global DPCookie::controls
  174. set DPCookie::controls "// Visual Components"
  175.  
  176. global DPCookie::events
  177. set DPCookie::events "// Events methods"
  178.  
  179. global DPCookie::properties
  180. set DPCookie::properties "// Properties"
  181.  
  182. global DPCookie::implement0
  183. set DPCookie::implement0 "// !! Implement this method !!"
  184.  
  185. global DPCookie::startUserSection
  186. set DPCookie::startUserSection "// Start user section"
  187.  
  188. global DPCookie::endUserSection
  189. set DPCookie::endUserSection "// End user section"
  190.  
  191. global DPCookie::startUserInclude
  192. set DPCookie::startUserInclude "// Start user include section"
  193.  
  194. global DPCookie::endUserInclude
  195. set DPCookie::endUserInclude "// End user include section"
  196.  
  197. global DPCookie::assocAttribs
  198. set DPCookie::assocAttribs "// Association attributes"
  199.  
  200. global DPCookie::userDefAttribs
  201. set DPCookie::userDefAttribs "// User defined attributes"
  202.  
  203. global DPCookie::formAttrib
  204. set DPCookie::formAttrib "(* Form attribute *)"
  205.  
  206. global DPCookie::userDefMethods
  207. set DPCookie::userDefMethods "// User defined methods"
  208.  
  209. global DPCookie::accessMethods
  210. set DPCookie::accessMethods "// Access methods"
  211.  
  212. global DPCookie::assocMethods
  213. set DPCookie::assocMethods "// Association methods"
  214.  
  215. global DPCookie::defaultConstDest
  216. set DPCookie::defaultConstDest "// Default constructor/destructor"
  217.  
  218. global DPCookie::classFeatureAttribs
  219. set DPCookie::classFeatureAttribs "// Class feature attributes"
  220.  
  221. global DPCookie::regenMarker
  222. set DPCookie::regenMarker "// Do not delete this line -- regeneration marker"
  223.  
  224. global DPCookie::obsoleteCode
  225. set DPCookie::obsoleteCode "// Obsolete code section"
  226.  
  227. global DPCookie::genProjectStart
  228. set DPCookie::genProjectStart "// Do not delete this block -- regeneration marker -- start"
  229.  
  230. global DPCookie::genProjectEnd
  231. set DPCookie::genProjectEnd "// Do not delete this block -- regeneration marker -- end"
  232.  
  233.  
  234. constructor DPCookie {class this} {
  235.     set this [GCObject::constructor $class $this]
  236.     # Start constructor user section
  237.     # End constructor user section
  238.     return $this
  239. }
  240.  
  241. method DPCookie::destructor {this} {
  242.     # Start destructor user section
  243.     # End destructor user section
  244. }
  245.  
  246. # Do not delete this line -- regeneration end marker
  247.  
  248. #---------------------------------------------------------------------------
  249. #      File:           @(#)dpenumcomp.tcl    /main/titanic/1
  250. #---------------------------------------------------------------------------
  251.  
  252. # Start user added include file section
  253. # End user added include file section
  254.  
  255.  
  256. Class DPEnumComponent : {GCObject} {
  257.     constructor
  258.     method destructor
  259.     method generate
  260.     attribute name
  261. }
  262.  
  263. constructor DPEnumComponent {class this} {
  264.     set this [GCObject::constructor $class $this]
  265.     # Start constructor user section
  266.     # End constructor user section
  267.     return $this
  268. }
  269.  
  270. method DPEnumComponent::destructor {this} {
  271.     # Start destructor user section
  272.     # End destructor user section
  273. }
  274.  
  275. method DPEnumComponent::generate {this section} {
  276.     $section append [$this name]
  277. }
  278.  
  279. # Do not delete this line -- regeneration end marker
  280.  
  281. #---------------------------------------------------------------------------
  282. #      File:           @(#)dpfeature.tcl    /main/titanic/2
  283. #---------------------------------------------------------------------------
  284.  
  285. # Start user added include file section
  286. # End user added include file section
  287.  
  288.  
  289. Class DPFeature : {GCObject} {
  290.     constructor
  291.     method destructor
  292.     attribute name
  293.     attribute access
  294.     attribute isClassFeature
  295.     attribute comment
  296. }
  297.  
  298. constructor DPFeature {class this} {
  299.     set this [GCObject::constructor $class $this]
  300.     $this access "Public"
  301.     $this isClassFeature 0
  302.     # Start constructor user section
  303.     # End constructor user section
  304.     return $this
  305. }
  306.  
  307. method DPFeature::destructor {this} {
  308.     # Start destructor user section
  309.     # End destructor user section
  310. }
  311.  
  312. # Do not delete this line -- regeneration end marker
  313.  
  314. #---------------------------------------------------------------------------
  315. #      File:           @(#)dpproject.tcl    /main/titanic/3
  316. #---------------------------------------------------------------------------
  317.  
  318. # Start user added include file section
  319. # End user added include file section
  320.  
  321.  
  322. Class DPProject : {GCObject} {
  323.     constructor
  324.     method destructor
  325.     method generate
  326.     method getUnit
  327.     method setUnit
  328.     method removeUnit
  329.     method getForm
  330.     method setForm
  331.     method removeForm
  332.     attribute name
  333.     attribute isLibrary
  334.     attribute unit
  335.     attribute form
  336. }
  337.  
  338. constructor DPProject {class this} {
  339.     set this [GCObject::constructor $class $this]
  340.     $this isLibrary 0
  341.     $this unit [Dictionary new]
  342.     $this form [Dictionary new]
  343.     # Start constructor user section
  344.     # End constructor user section
  345.     return $this
  346. }
  347.  
  348. method DPProject::destructor {this} {
  349.     # Start destructor user section
  350.     # End destructor user section
  351. }
  352.  
  353. method DPProject::generate {this typeToClassDict} {
  354.  
  355.     $typeToClassDict foreach ooplclass fileDict {
  356.         if {[[$this unit] exists [$ooplclass getName]]} {
  357.             set unitfile [DPTextSection new]
  358.             [[$this unit] set [$ooplclass getName]] generate $unitfile
  359.             $fileDict set "pas" $unitfile
  360.  
  361.             if {[[[$this unit] set [$ooplclass getName]] unitType] == "formclass"} {
  362.                 set formfile [DPTextSection new]
  363.                 [[$this unit] set [$ooplclass getName]] generateForm $formfile
  364.                 $fileDict set "txt" $formfile
  365.             }
  366.         }
  367.     }
  368. }
  369.  
  370. # Do not delete this line -- regeneration end marker
  371.  
  372. method DPProject::getUnit {this name} {
  373.     return [[$this unit] set $name]
  374. }
  375.  
  376. method DPProject::setUnit {this name newUnit} {
  377.     [$this unit] set $name $newUnit
  378. }
  379.  
  380. method DPProject::removeUnit {this name} {
  381.     [$this unit] unset $name
  382. }
  383.  
  384. method DPProject::getForm {this name} {
  385.     return [[$this form] set $name]
  386. }
  387.  
  388. method DPProject::setForm {this name newForm} {
  389.     [$this form] set $name $newForm
  390. }
  391.  
  392. method DPProject::removeForm {this name} {
  393.     [$this form] unset $name
  394. }
  395.  
  396. #---------------------------------------------------------------------------
  397. #      File:           @(#)dptextsect.tcl    /main/titanic/1
  398. #---------------------------------------------------------------------------
  399.  
  400. # Start user added include file section
  401. # End user added include file section
  402.  
  403.  
  404. Class DPTextSection : {TextSection} {
  405.     constructor
  406.     method destructor
  407. }
  408.  
  409. constructor DPTextSection {class this} {
  410.     set this [TextSection::constructor $class $this]
  411.     # Start constructor user section
  412.     $this indent [$this indent] "  "
  413.     # End constructor user section
  414.     return $this
  415. }
  416.  
  417. method DPTextSection::destructor {this} {
  418.     # Start destructor user section
  419.     # End destructor user section
  420. }
  421.  
  422. # Do not delete this line -- regeneration end marker
  423.  
  424. #---------------------------------------------------------------------------
  425. #      File:           @(#)dptype.tcl    /main/titanic/2
  426. #---------------------------------------------------------------------------
  427.  
  428. # Start user added include file section
  429. # End user added include file section
  430.  
  431.  
  432. Class DPType : {GCObject} {
  433.     constructor
  434.     method destructor
  435.     method addAsInclude
  436.     method generate
  437.     attribute name
  438.     attribute isArray
  439.     attribute arraySize
  440.     attribute includeType
  441.     attribute includeName
  442. }
  443.  
  444. constructor DPType {class this} {
  445.     set this [GCObject::constructor $class $this]
  446.     $this isArray 0
  447.     $this includeType "none"
  448.     # Start constructor user section
  449.     # End constructor user section
  450.     return $this
  451. }
  452.  
  453. method DPType::destructor {this} {
  454.     # Start destructor user section
  455.     # End destructor user section
  456. }
  457.  
  458. method DPType::addAsInclude {this unit} {
  459.     switch [$this includeType] {
  460.         "user" {
  461.             $unit addInclude [$this includeName]
  462.         }
  463.         "imp" {
  464.             $unit addImpinclude [$this includeName]
  465.         }
  466.         "system" {
  467.             $unit addSysteminclude [$this includeName]
  468.         }
  469.         "none" {
  470.         }
  471.         default {
  472.         }
  473.     }
  474. }
  475.  
  476. method DPType::generate {this whole unit} {
  477.     if {[$this isArray]} {
  478.         $whole append "array[1.."
  479.         $whole append [$this arraySize]
  480.         $whole append "] of "
  481.     }
  482.     $whole append [$this name]
  483.     $this addAsInclude $unit
  484. }
  485.  
  486. # Do not delete this line -- regeneration end marker
  487.  
  488. #---------------------------------------------------------------------------
  489. #      File:           @(#)dpunit.tcl    /main/titanic/10
  490. #---------------------------------------------------------------------------
  491.  
  492. # Start user added include file section
  493. # End user added include file section
  494.  
  495.  
  496. Class DPUnit : {GCObject} {
  497.     constructor
  498.     method destructor
  499.     method addInclude
  500.     method addSysteminclude
  501.     method addImpinclude
  502.     method generateDeclaration
  503.     method generateMethods
  504.     method generateIncludes
  505.     method generateImpIncludes
  506.     method generate
  507.     attribute name
  508.     attribute unitName
  509.     attribute unitType
  510.     attribute includeSet
  511.     attribute impuserinclude
  512.     attribute comment
  513.     attribute systemincludeSet
  514.     attribute userinclude
  515.     attribute impincludeSet
  516. }
  517.  
  518. constructor DPUnit {class this} {
  519.     set this [GCObject::constructor $class $this]
  520.     $this unitType "none"
  521.     $this includeSet [List new]
  522.     $this systemincludeSet [List new]
  523.     $this impincludeSet [List new]
  524.     # Start constructor user section
  525.     $this userinclude [TextSection new]
  526.     $this impuserinclude [TextSection new]
  527.     # End constructor user section
  528.     return $this
  529. }
  530.  
  531. method DPUnit::destructor {this} {
  532.     # Start destructor user section
  533.     # End destructor user section
  534. }
  535.  
  536. method DPUnit::addInclude {this unit} {
  537.     if {$unit == ""} {
  538.         return
  539.     }
  540.     if {[[$this impincludeSet] search -exact $unit] != -1} {
  541.         [$this impincludeSet] removeValue $unit
  542.     }
  543.     if {$unit != [$this unitName] && [[$this includeSet] search -exact $unit] == -1} {
  544.         [$this includeSet] insert $unit
  545.     }
  546. }
  547.  
  548. method DPUnit::addSysteminclude {this unit} {
  549.     if {$unit == ""} {
  550.         return
  551.     }
  552.     if {$unit != [$this unitName] && [[$this systemincludeSet] search -exact $unit] == -1} {
  553.         if {$unit != "System"} {
  554.             [$this systemincludeSet] insert $unit
  555.         }
  556.     }
  557. }
  558.  
  559. method DPUnit::addImpinclude {this unit} {
  560.     if {$unit == ""} {
  561.         return
  562.     }
  563.     if {$unit != [$this unitName] && [[$this impincludeSet] search -exact $unit] == -1 && [[$this includeSet] search -exact $unit] == -1} {
  564.         [$this impincludeSet] insert $unit
  565.     }
  566. }
  567.  
  568. method DPUnit::generateDeclaration {this section} {
  569. }
  570.  
  571. method DPUnit::generateMethods {this section} {
  572.     $section append "${DPCookie::regenMarker}\n\n"
  573. }
  574.  
  575. method DPUnit::generateIncludes {this section} {
  576.     set userContents [string trim [[$this userinclude] contents]]
  577.  
  578.     if {$userContents != "" || ![[$this includeSet] empty] || ![[$this systemincludeSet] empty]} {
  579.         $section append "uses\n" 
  580.     }
  581.  
  582.     $section indent +
  583.     $section append "${DPCookie::startUserInclude}\n"
  584.  
  585.     # Uses
  586.     #
  587.  
  588.     set first 1
  589.     if {$userContents != ""} {
  590.         set usesList [split [[$this userinclude] contents] "\n"]
  591.  
  592.         set oldremain ""
  593.         foreach line $usesList {
  594.             if {[regexp {^[     ]*([^     ,;]+)([,;])?([     ]*.*)$} $line total name dummy remain]} {
  595.                 if {$first} {
  596.                     set first 0
  597.                 } else {
  598.                     $section append ","
  599.                     $section append "${oldremain}\n"
  600.                 }
  601.                 set oldremain $remain
  602.                 $section append "${name}"
  603.             }
  604.         }
  605.         if {!$first} {
  606.             if {![[$this includeSet] empty] || ![[$this systemincludeSet] empty]} {
  607.                 $section append ","
  608.             }
  609.             $section append "${remain}\n"
  610.         }
  611.     }
  612.     $section append "${DPCookie::endUserInclude}\n"
  613.  
  614.     set first 1
  615.     if {![[$this systemincludeSet] empty]} {
  616.         [$this systemincludeSet] foreach include {
  617.             if {$first} {
  618.                 set first 0
  619.             } else {
  620.                 $section append ",\n"
  621.             }
  622.             $section append "${include}"
  623.         }
  624.     }
  625.     if {![[$this includeSet] empty]} {
  626.         [$this includeSet] foreach include {
  627.             if {$first} {
  628.                 set first 0
  629.             } else {
  630.                 $section append ",\n"
  631.             }
  632.             $section append "${include}"
  633.         }
  634.     }
  635.  
  636.     if {$userContents != "" || ![[$this includeSet] empty] || ![[$this systemincludeSet] empty]} {
  637.         $section append ";\n"
  638.     }
  639.  
  640.     $section append "\n"
  641.     $section indent -
  642. }
  643.  
  644. method DPUnit::generateImpIncludes {this section} {
  645.     set userContents [string trim [[$this impuserinclude] contents]]
  646.  
  647.     if {$userContents != "" || ![[$this impincludeSet] empty]} {
  648.         $section append "uses\n" 
  649.     }
  650.  
  651.     $section indent +
  652.     $section append "${DPCookie::startUserInclude}\n"
  653.  
  654.     # Uses
  655.     #
  656.     set first 1
  657.     if {$userContents != ""} {
  658.         set usesList [split [[$this impuserinclude] contents] "\n"]
  659.  
  660.         set oldremain ""
  661.         foreach line $usesList {
  662.             if {[regexp {^[     ]*([^     ,;]+)([,;])?([     ]*.*)$} $line total name dummy remain]} {
  663.                 if {$first} {
  664.                     set first 0
  665.                 } else {
  666.                     $section append ","
  667.                     $section append "${oldremain}\n"
  668.                 }
  669.                 set oldremain $remain
  670.                 $section append "${name}"
  671.             }
  672.         }
  673.         if {!$first} {
  674.             if {![[$this impincludeSet] empty]} {
  675.                 $section append ","
  676.             }
  677.             $section append "${remain}\n"
  678.         }
  679.     }
  680.     $section append "${DPCookie::endUserInclude}\n"
  681.  
  682.     set first 1
  683.     if {![[$this impincludeSet] empty]} {
  684.         [$this impincludeSet] foreach include {
  685.             if {$first} {
  686.                 set first 0
  687.             } else {
  688.                 $section append ",\n"
  689.             }
  690.             $section append "${include}"
  691.         }
  692.     }
  693.     if {$userContents != "" || ![[$this impincludeSet] empty]} {
  694.         $section append ";\n"
  695.     }
  696.     $section append "\n"
  697.     $section indent -
  698. }
  699.  
  700. method DPUnit::generate {this section} {
  701.  
  702.     set declSection [DPTextSection new]
  703.     set defSection [DPTextSection new]
  704.     set inclSection [DPTextSection new]
  705.     set impInclSection [DPTextSection new]
  706.  
  707.     # Declaration part
  708.     $this generateDeclaration $declSection
  709.  
  710.     # Definition part
  711.     $this generateMethods $defSection
  712.  
  713.     # Includes part
  714.     $this generateIncludes $inclSection
  715.  
  716.     # Implementation includes part
  717.     $this generateImpIncludes $impInclSection
  718.  
  719.     expandHeaderIntoSection "[$this unitName].${DPFileHandler::PASType}" ${DPFileHandler::PASType} $section
  720.     $section append "unit [$this unitName];\n\n"
  721.  
  722.     $section append "interface\n\n"
  723.     $section appendSect $inclSection
  724.     $section append "type\n"
  725.     $section appendSect $declSection
  726.  
  727.     $section append "\n\nimplementation\n\n"
  728.     $section appendSect $impInclSection
  729.     $section appendSect $defSection
  730.  
  731.     $section append "\nend.\n"
  732. }
  733.  
  734. # Do not delete this line -- regeneration end marker
  735.  
  736. #---------------------------------------------------------------------------
  737. #      File:           @(#)dpvariable.tcl    /main/titanic/3
  738. #---------------------------------------------------------------------------
  739.  
  740. # Start user added include file section
  741. # End user added include file section
  742.  
  743.  
  744. Class DPVariable : {DPFeature} {
  745.     constructor
  746.     method destructor
  747.     method generate
  748.     method addProc
  749.     method removeProc
  750.     attribute initvalue
  751.     attribute formVar
  752.     attribute type
  753.     attribute procSet
  754. }
  755.  
  756. constructor DPVariable {class this type} {
  757.     set this [DPFeature::constructor $class $this]
  758.     $this formVar 0
  759.     $this type $type
  760.     $this procSet [List new]
  761.     # Start constructor user section
  762.     # End constructor user section
  763.     return $this
  764. }
  765.  
  766. method DPVariable::destructor {this} {
  767.     # Start destructor user section
  768.     # End destructor user section
  769.     $this DPFeature::destructor
  770. }
  771.  
  772. method DPVariable::generate {this whole unit} {
  773.     if {[$this comment] != ""} {
  774.         [$this comment] generate $whole
  775.     }
  776.     $whole append "[$this name]: "
  777.     [$this type] generate $whole $unit
  778.     if {[$this formVar] != 0} {
  779.         $whole append "   ${DPCookie::formAttrib}"
  780.     }
  781.     if {[$this initvalue] != ""} {
  782.         $whole append "   (* = [$this initvalue] *)"
  783.     }
  784.     $whole append ";" 
  785.     $whole append "\n" 
  786. }
  787.  
  788. # Do not delete this line -- regeneration end marker
  789.  
  790. method DPVariable::addProc {this newProc} {
  791.     [$this procSet] append $newProc
  792.  
  793. }
  794.  
  795. method DPVariable::removeProc {this oldProc} {
  796.     [$this procSet] removeValue $oldProc
  797. }
  798.  
  799. #---------------------------------------------------------------------------
  800. #      File:           @(#)dpcontrol.tcl    /main/titanic/5
  801. #---------------------------------------------------------------------------
  802.  
  803. # Start user added include file section
  804. # End user added include file section
  805.  
  806.  
  807. Class DPControl : {DPVariable} {
  808.     constructor
  809.     method destructor
  810.     method generate
  811.     method generateComponent
  812.     method parent
  813.     method addEvent
  814.     method removeEvent
  815.     method addSortedChild
  816.     method removeSortedChild
  817.     method childSet
  818.     method addChild
  819.     method removeChild
  820.     attribute controlType
  821.     attribute compclass
  822.     attribute properties
  823.     attribute _parent
  824.     attribute eventSet
  825.     attribute sortedChildSet
  826.     attribute _childSet
  827. }
  828.  
  829. constructor DPControl {class this type} {
  830.     set this [DPVariable::constructor $class $this $type]
  831.     $this controlType "normal"
  832.     $this eventSet [List new]
  833.     $this sortedChildSet [List new]
  834.     $this _childSet [List new]
  835.     # Start constructor user section
  836.     # End constructor user section
  837.     return $this
  838. }
  839.  
  840. method DPControl::destructor {this} {
  841.     # Start destructor user section
  842.     # End destructor user section
  843.     $this DPVariable::destructor
  844. }
  845.  
  846. method DPControl::generate {this section unit} {
  847.     if {[$this comment] != ""} {
  848.         [$this comment] generate $section
  849.     }
  850.     $section append "[$this name]: "
  851.     [$this type] generate $section $unit
  852.     if {[$this compclass] != ""} {
  853.         $section append " (* Component:[$this compclass] *)"
  854.     }
  855.     $section append ";\n" 
  856. }
  857.  
  858. method DPControl::generateComponent {this section} {
  859.     $section append "object "
  860.     $section append "[$this name]: [[$this type] name]\n"
  861.     $section indent +
  862.     [$this eventSet] foreach event {
  863.         $event generate $section
  864.     }
  865.     if {[$this controlType] == "TField"} {
  866.         if {[[$this properties] contents] == ""} {
  867.                 $section append "FieldName = '[$this name]Field'\n"
  868.         }
  869.     }
  870.     if {[$this properties] != ""} {
  871.         $section appendSect [$this properties]
  872.     }
  873.     [$this sortedChildSet] foreach child {
  874.         $child generateComponent $section
  875.     }
  876.     [$this childSet] foreach child {
  877.         $child generateComponent $section
  878.     }
  879.     $section indent -
  880.     $section append "end\n"
  881. }
  882.  
  883. # Do not delete this line -- regeneration end marker
  884.  
  885. method DPControl::parent {this args} {
  886.     if {$args == ""} {
  887.         return [$this _parent]
  888.     }
  889.     set ref [$this _parent]
  890.     if {$ref != ""} {
  891.         [$ref _childSet] removeValue $this
  892.     }
  893.     set obj [lindex $args 0]
  894.     if {$obj != ""} {
  895.         [$obj _childSet] append $this
  896.     }
  897.     $this _parent $obj
  898. }
  899.  
  900. method DPControl::addEvent {this newEvent} {
  901.     [$this eventSet] append $newEvent
  902.  
  903. }
  904.  
  905. method DPControl::removeEvent {this oldEvent} {
  906.     [$this eventSet] removeValue $oldEvent
  907. }
  908.  
  909. method DPControl::addSortedChild {this newSortedChild} {
  910.     [$this sortedChildSet] append $newSortedChild
  911.  
  912. }
  913.  
  914. method DPControl::removeSortedChild {this oldSortedChild} {
  915.     [$this sortedChildSet] removeValue $oldSortedChild
  916. }
  917.  
  918. method DPControl::childSet {this} {
  919.     return [$this _childSet]
  920. }
  921.  
  922. method DPControl::addChild {this newChild} {
  923.     [$this _childSet] append $newChild
  924.     $newChild _parent $this
  925. }
  926.  
  927. method DPControl::removeChild {this oldChild} {
  928.     $oldChild _parent ""
  929.     [$this _childSet] removeValue $oldChild
  930. }
  931.  
  932. #---------------------------------------------------------------------------
  933. #      File:           @(#)dpmethod.tcl    /main/titanic/4
  934. #---------------------------------------------------------------------------
  935.  
  936. # Start user added include file section
  937. # End user added include file section
  938.  
  939.  
  940. Class DPMethod : {DPFeature} {
  941.     constructor
  942.     method destructor
  943.     method generateTypes
  944.     method generateGenCode
  945.     method generateUserCode
  946.     method generateReturnType
  947.     method generateArguments
  948.     method generateDeclaration
  949.     method generateDefinition
  950.     method generate
  951.     method addArg
  952.     method removeArg
  953.     attribute methodType
  954.     attribute userCodeFirst
  955.     attribute hasUserSection
  956.     attribute methodCalling
  957.     attribute isVirtual
  958.     attribute isDynamic
  959.     attribute isAbstract
  960.     attribute isOverride
  961.     attribute usercode
  962.     attribute gencode
  963.     attribute gentypes
  964.     attribute usertypes
  965.     attribute argSet
  966. }
  967.  
  968. constructor DPMethod {class this} {
  969.     set this [DPFeature::constructor $class $this]
  970.     $this methodType "None"
  971.     $this userCodeFirst 0
  972.     $this hasUserSection 0
  973.     $this isVirtual 0
  974.     $this isDynamic 0
  975.     $this isAbstract 0
  976.     $this isOverride 0
  977.     $this argSet [List new]
  978.     # Start constructor user section
  979.     # End constructor user section
  980.     return $this
  981. }
  982.  
  983. method DPMethod::destructor {this} {
  984.     # Start destructor user section
  985.     # End destructor user section
  986.     $this DPFeature::destructor
  987. }
  988.  
  989. method DPMethod::generateTypes {this whole} {
  990.     if {[$this gentypes] != ""} {
  991.         $whole appendSect [$this gentypes]
  992.     }
  993.     if {[$this hasUserSection]} {
  994.         $whole indent +
  995.         $whole append "${DPCookie::startUserSection}\n"
  996.         $whole indent -
  997.     }
  998.     if {[$this usertypes] != ""} {
  999.         $whole appendSect [$this usertypes]
  1000.     }
  1001.     if {[$this hasUserSection]} {
  1002.         $whole indent +
  1003.         $whole append "${DPCookie::endUserSection}\n"
  1004.         $whole indent -
  1005.     }
  1006. }
  1007.  
  1008. method DPMethod::generateGenCode {this whole} {
  1009.     $whole indent +
  1010.     if {[$this gencode] != ""} {
  1011.         $whole appendSect [$this gencode]
  1012.     } elseif {![$this hasUserSection] && [$this usercode] == ""} {
  1013.         $whole append "${DPCookie::implement0}\n"
  1014.     }
  1015.     $whole indent -
  1016. }
  1017.  
  1018. method DPMethod::generateUserCode {this whole} {
  1019.     if {[$this hasUserSection]} {
  1020.         $whole indent +
  1021.         $whole append "${DPCookie::startUserSection}\n"
  1022.         $whole indent -
  1023.     }
  1024.     if {[$this usercode] != ""} {
  1025.         $whole appendSect [$this usercode]
  1026.     }
  1027.     if {[$this hasUserSection]} {
  1028.         $whole indent +
  1029.         $whole append "${DPCookie::endUserSection}\n"
  1030.         $whole indent -
  1031.     }
  1032. }
  1033.  
  1034. method DPMethod::generateReturnType {this whole unit} {
  1035. }
  1036.  
  1037. method DPMethod::generateArguments {this whole unit} {
  1038.  
  1039.     if {[[$this argSet] contents] != ""} {
  1040.         $whole append "("
  1041.         set first 1
  1042.         [$this argSet] foreach arg {
  1043.             if {$first} {
  1044.                 set first 0
  1045.             } else {
  1046.                 $whole append "; "
  1047.             }
  1048.             $arg generate $whole $unit
  1049.         }
  1050.         $whole append ")"
  1051.     }
  1052.     $this generateReturnType $whole $unit
  1053.     $whole append ";"
  1054. }
  1055.  
  1056. method DPMethod::generateDeclaration {this whole unit} {
  1057.     if {[$this isClassFeature]} {
  1058.         $whole append "class " 
  1059.     }
  1060.     $whole append "[$this methodType] [$this name]"
  1061.     $this generateArguments $whole $unit
  1062.  
  1063.     if {[$this isOverride]} {
  1064.         $whole append " override;"
  1065.     }
  1066.     if {[$this isVirtual]} {
  1067.         $whole append " virtual;"
  1068.     }
  1069.     if {[$this isDynamic]} {
  1070.         $whole append " dynamic;"
  1071.     }
  1072.  
  1073.     switch [$this methodCalling] {
  1074.         "StdCall"    {
  1075.             $whole append " stdcall;"
  1076.         }
  1077.         "SafeCall"    {
  1078.             $whole append " safecall;"
  1079.         }
  1080.         "Pascal"    {
  1081.             $whole append " pascal;"
  1082.         }
  1083.         "CDecl"        {
  1084.             $whole append " cdecl;"
  1085.         }
  1086.         default    {
  1087.         }
  1088.     }
  1089.  
  1090.     if {[$this isAbstract]} {
  1091.         $whole append " abstract;"
  1092.     }
  1093.     $whole append "\n"
  1094. }
  1095.  
  1096. method DPMethod::generateDefinition {this whole unit} {
  1097.     if {[$this isClassFeature]} {
  1098.         $whole append "class " 
  1099.     }
  1100.     $whole append "[$this methodType] [$unit name].[$this name]"
  1101.  
  1102.     $this generateArguments $whole $unit
  1103. }
  1104.  
  1105. method DPMethod::generate {this whole unit} {
  1106.     if {[$this comment] != ""} {
  1107.         [$this comment] generate $whole
  1108.     }
  1109.     $this generateDefinition $whole $unit
  1110.  
  1111.     $whole append "\n"
  1112.  
  1113.     $this generateTypes $whole
  1114.     $whole append "begin\n"
  1115.  
  1116.     if {[$this userCodeFirst]} {
  1117.         $this generateUserCode $whole
  1118.         $this generateGenCode $whole
  1119.     } else {
  1120.         $this generateGenCode $whole
  1121.         $this generateUserCode $whole
  1122.     }
  1123.     $whole append "end;\n\n\n"
  1124. }
  1125.  
  1126. # Do not delete this line -- regeneration end marker
  1127.  
  1128. method DPMethod::addArg {this newArg} {
  1129.     [$this argSet] append $newArg
  1130.  
  1131. }
  1132.  
  1133. method DPMethod::removeArg {this oldArg} {
  1134.     [$this argSet] removeValue $oldArg
  1135. }
  1136.  
  1137. #---------------------------------------------------------------------------
  1138. #      File:           @(#)dpprocedur.tcl    /main/titanic/1
  1139. #---------------------------------------------------------------------------
  1140.  
  1141. # Start user added include file section
  1142. # End user added include file section
  1143.  
  1144.  
  1145. Class DPProcedure : {DPMethod} {
  1146.     constructor
  1147.     method destructor
  1148.     attribute methodType
  1149. }
  1150.  
  1151. constructor DPProcedure {class this} {
  1152.     set this [DPMethod::constructor $class $this]
  1153.     $this methodType "procedure"
  1154.     # Start constructor user section
  1155.     # End constructor user section
  1156.     return $this
  1157. }
  1158.  
  1159. method DPProcedure::destructor {this} {
  1160.     # Start destructor user section
  1161.     # End destructor user section
  1162.     $this DPMethod::destructor
  1163. }
  1164.  
  1165. # Do not delete this line -- regeneration end marker
  1166.  
  1167. #---------------------------------------------------------------------------
  1168. #      File:           @(#)dpevent.tcl    /main/titanic/3
  1169. #---------------------------------------------------------------------------
  1170.  
  1171. # Start user added include file section
  1172. # End user added include file section
  1173.  
  1174.  
  1175. Class DPEvent : {DPProcedure} {
  1176.     constructor
  1177.     method destructor
  1178.     method generateDeclaration
  1179.     attribute methodType
  1180.     attribute component
  1181.     attribute compclass
  1182. }
  1183.  
  1184. constructor DPEvent {class this} {
  1185.     set this [DPProcedure::constructor $class $this]
  1186.     $this methodType "procedure"
  1187.     # Start constructor user section
  1188.     # End constructor user section
  1189.     return $this
  1190. }
  1191.  
  1192. method DPEvent::destructor {this} {
  1193.     # Start destructor user section
  1194.     # End destructor user section
  1195.     $this DPProcedure::destructor
  1196. }
  1197.  
  1198. method DPEvent::generateDeclaration {this whole unit} {
  1199.     $whole append "[$this methodType] [$this name]"
  1200.     $this generateArguments $whole $unit
  1201.  
  1202.     #if {[$this component] != ""} {
  1203.     #    $whole append "   ${DPCookie::component}[$this component]:[$this compclass]"
  1204.     #}
  1205.     $whole append "\n"
  1206. }
  1207.  
  1208. # Do not delete this line -- regeneration end marker
  1209.  
  1210. #---------------------------------------------------------------------------
  1211. #      File:           @(#)dprecordun.tcl    /main/titanic/1
  1212. #---------------------------------------------------------------------------
  1213.  
  1214. # Start user added include file section
  1215. # End user added include file section
  1216.  
  1217.  
  1218. Class DPRecordUnit : {DPUnit} {
  1219.     constructor
  1220.     method destructor
  1221.     method generateDeclaration
  1222.     method addField
  1223.     method removeField
  1224.     attribute unitType
  1225.     attribute fieldSet
  1226. }
  1227.  
  1228. constructor DPRecordUnit {class this} {
  1229.     set this [DPUnit::constructor $class $this]
  1230.     $this unitType "record"
  1231.     $this fieldSet [List new]
  1232.     # Start constructor user section
  1233.     # End constructor user section
  1234.     return $this
  1235. }
  1236.  
  1237. method DPRecordUnit::destructor {this} {
  1238.     # Start destructor user section
  1239.     # End destructor user section
  1240.     $this DPUnit::destructor
  1241. }
  1242.  
  1243. method DPRecordUnit::generateDeclaration {this section} {
  1244.     $section indent +
  1245.     $section append "[$this name] = record\n"
  1246.     $section indent +
  1247.     [$this fieldSet] foreach field {
  1248.         $field generate $section $this
  1249.     }
  1250.     $section indent -
  1251.     $section append "end;\n"
  1252.     $section indent -
  1253. }
  1254.  
  1255. # Do not delete this line -- regeneration end marker
  1256.  
  1257. method DPRecordUnit::addField {this newField} {
  1258.     [$this fieldSet] append $newField
  1259.  
  1260. }
  1261.  
  1262. method DPRecordUnit::removeField {this oldField} {
  1263.     [$this fieldSet] removeValue $oldField
  1264. }
  1265.  
  1266. #---------------------------------------------------------------------------
  1267. #      File:           @(#)dpclass.tcl    /main/titanic/13
  1268. #---------------------------------------------------------------------------
  1269.  
  1270. # Start user added include file section
  1271. # End user added include file section
  1272.  
  1273.  
  1274. Class DPClass : {DPUnit} {
  1275.     constructor
  1276.     method destructor
  1277.     method generateGlobVars
  1278.     method generateDeclaration
  1279.     method generateMethods
  1280.     method addGlobvar
  1281.     method removeGlobvar
  1282.     method addAssocvar
  1283.     method removeAssocvar
  1284.     method addUservar
  1285.     method removeUservar
  1286.     method addGenmethod
  1287.     method removeGenmethod
  1288.     method addAssocgenmethod
  1289.     method removeAssocgenmethod
  1290.     method addEvent
  1291.     method removeEvent
  1292.     method addSuperinterface
  1293.     method removeSuperinterface
  1294.     method addProperty
  1295.     method removeProperty
  1296.     method addUsermethod
  1297.     method removeUsermethod
  1298.     attribute unitType
  1299.     attribute userConstructors
  1300.     attribute constructr
  1301.     attribute destructr
  1302.     attribute superclass
  1303.     attribute globvarSet
  1304.     attribute assocvarSet
  1305.     attribute uservarSet
  1306.     attribute genmethodSet
  1307.     attribute assocgenmethodSet
  1308.     attribute eventSet
  1309.     attribute obsoletecode
  1310.     attribute superinterfaceSet
  1311.     attribute propertySet
  1312.     attribute usermethodSet
  1313. }
  1314.  
  1315. constructor DPClass {class this} {
  1316.     set this [DPUnit::constructor $class $this]
  1317.     $this unitType "class"
  1318.     $this userConstructors 0
  1319.     $this globvarSet [List new]
  1320.     $this assocvarSet [List new]
  1321.     $this uservarSet [List new]
  1322.     $this genmethodSet [List new]
  1323.     $this assocgenmethodSet [List new]
  1324.     $this eventSet [List new]
  1325.     $this superinterfaceSet [List new]
  1326.     $this propertySet [List new]
  1327.     $this usermethodSet [List new]
  1328.     # Start constructor user section
  1329.     # End constructor user section
  1330.     return $this
  1331. }
  1332.  
  1333. method DPClass::destructor {this} {
  1334.     # Start destructor user section
  1335.     # End destructor user section
  1336.     $this DPUnit::destructor
  1337. }
  1338.  
  1339. method DPClass::generateGlobVars {this section} {
  1340.     if {![[$this globvarSet] empty]} {
  1341.         $section append "\n${DPCookie::classFeatureAttribs}\n"
  1342.         $section append "var\n"
  1343.         $section indent +
  1344.         [$this globvarSet] foreach var {
  1345.             $var generate $section $this
  1346.         }
  1347.         $section indent -
  1348.     }
  1349. }
  1350.  
  1351. method DPClass::generateDeclaration {this section} {
  1352.  
  1353.     set sectionList {NoneSection ProtectedSection PrivateSection PublicSection PublishedSection}
  1354.     set countList {NoneCount ProtectedCount PrivateCount PublicCount PublishedCount}
  1355.  
  1356.     $section indent +
  1357.     if {[$this comment] != ""} {
  1358.         [$this comment] generate $section
  1359.     }
  1360.  
  1361.     $section append "[$this name] = class"
  1362.  
  1363.     # Generate superclass
  1364.     if {[$this superclass] != ""} {
  1365.         $section append "("
  1366.         [$this superclass] generate $section $this
  1367.         [$this superinterfaceSet] foreach intface {
  1368.             $section append ", "
  1369.             $intface generate $section $this
  1370.         }
  1371.         $section append ")"
  1372.     }
  1373.     $section append "\n"
  1374.  
  1375.     if {[$this unitType] == "formclass"} {
  1376.         $section indent +
  1377.         $section append "\n${DPCookie::controls}\n"
  1378.         [[$this form] control] foreach key control {
  1379.             $control generate $section $this
  1380.         }
  1381.         $section append "\n${DPCookie::events}\n"
  1382.         [$this eventSet] foreach evt {
  1383.             $evt generateDeclaration $section $this
  1384.         }
  1385.         $section indent -
  1386.     }
  1387.  
  1388.     # Create access sections
  1389.     #
  1390.     foreach sec $sectionList {
  1391.         set $sec [DPTextSection new]
  1392.         [set $sec] indent +
  1393.     }
  1394.  
  1395.     # User defined attributes
  1396.     #
  1397.     foreach sec $sectionList {
  1398.         [set $sec] append "\n${DPCookie::userDefAttribs}\n"
  1399.     }
  1400.     [$this uservarSet] foreach var {
  1401.         $var generate [set [$var access]Section] $this
  1402.     }
  1403.  
  1404.     # Association attributes
  1405.     #
  1406.     foreach count $countList {
  1407.         set $count 0
  1408.     }
  1409.     [$this assocvarSet] foreach var {
  1410.         if {[set [$var access]Count] == 0} {
  1411.             [set [$var access]Section] append "\n${DPCookie::assocAttribs}\n"
  1412.         }
  1413.         incr [$var access]Count
  1414.         $var generate [set [$var access]Section] $this
  1415.     }
  1416.  
  1417.     # Constructor / Destructor
  1418.     #
  1419.     foreach count $countList {
  1420.         set $count 0
  1421.     }
  1422.     if {[$this constructr] != ""} {
  1423.         if {[set [[$this constructr] access]Count] == 0} {
  1424.             [set [[$this constructr] access]Section] append "\n${DPCookie::defaultConstDest}\n"
  1425.         }
  1426.         incr [[$this constructr] access]Count
  1427.         [$this constructr] generateDeclaration [set [[$this constructr] access]Section] $this
  1428.     }
  1429.     if {[$this destructr] != ""} {
  1430.         if {[set [[$this destructr] access]Count] == 0} {
  1431.             [set [[$this destructr] access]Section] append "\n${DPCookie::defaultConstDest}\n"
  1432.         }
  1433.         incr [[$this destructr] access]Count
  1434.         [$this destructr] generateDeclaration [set [[$this destructr] access]Section] $this
  1435.     }
  1436.  
  1437.     # User methods
  1438.     #
  1439.     foreach sec $sectionList {
  1440.         [set $sec] append "\n${DPCookie::userDefMethods}\n"
  1441.     }
  1442.     [$this usermethodSet] foreach method {
  1443.         $method generateDeclaration [set [$method access]Section] $this
  1444.     }
  1445.  
  1446.     # Access methods
  1447.     #
  1448.     foreach count $countList {
  1449.         set $count 0
  1450.     }
  1451.     [$this genmethodSet] foreach method {
  1452.         if {[set [$method access]Count] == 0} {
  1453.             [set [$method access]Section] append "\n${DPCookie::accessMethods}\n"
  1454.         }
  1455.         incr [$method access]Count
  1456.         $method generateDeclaration [set [$method access]Section] $this
  1457.     }
  1458.  
  1459.     # Association methods
  1460.     #
  1461.     foreach count $countList {
  1462.         set $count 0
  1463.     }
  1464.     [$this assocgenmethodSet] foreach method {
  1465.         if {[set [$method access]Count] == 0} {
  1466.             [set [$method access]Section] append "\n${DPCookie::assocMethods}\n"
  1467.         }
  1468.         incr [$method access]Count
  1469.         $method generateDeclaration [set [$method access]Section] $this
  1470.     }
  1471.  
  1472.     # Properties
  1473.     #
  1474.     foreach sec $sectionList {
  1475.         [set $sec] append "\n${DPCookie::properties}\n"
  1476.     }
  1477.     [$this propertySet] foreach prop {
  1478.         $prop generate [set [$prop access]Section] $this
  1479.     }
  1480.  
  1481.     $section append "\nprivate"
  1482.     $section appendSect $PrivateSection
  1483.     $section append "\nprotected"
  1484.     $section appendSect $ProtectedSection
  1485.     $section append "\npublic"
  1486.     $section appendSect $PublicSection
  1487.     $section append "\npublished"
  1488.     $section appendSect $PublishedSection
  1489.     $section append "end;\n"
  1490.     $section indent -
  1491.  
  1492.     $this generateGlobVars $section
  1493. }
  1494.  
  1495. method DPClass::generateMethods {this section} {
  1496.  
  1497.     if {[$this unitType] == "formclass"} {
  1498.         $section append "\{\$R \*.DFM\}\n\n"
  1499.     }
  1500.  
  1501.     if {[$this constructr] != ""} {
  1502.         [$this constructr] generate $section $this
  1503.     }
  1504.     if {[$this destructr] != ""} {
  1505.         [$this destructr] generate $section $this
  1506.     }
  1507.  
  1508.     [$this usermethodSet] foreach method {
  1509.         if {![$method isAbstract]} {
  1510.             $method generate $section $this
  1511.         }
  1512.     }
  1513.  
  1514.     if {[$this unitType] == "formclass"} {
  1515.         [$this eventSet] foreach evt {
  1516.             $evt generate $section $this
  1517.         }
  1518.     }
  1519.  
  1520.     $section append "${DPCookie::regenMarker}\n\n"
  1521.     [$this genmethodSet] foreach method {
  1522.         $method generate $section $this
  1523.     }
  1524.     [$this assocgenmethodSet] foreach method {
  1525.         $method generate $section $this
  1526.     }
  1527.  
  1528.     if {[$this obsoletecode] != ""} {
  1529.         $section append "${DPCookie::obsoleteCode}\n\n"
  1530.         $section append "\{\$IFDEF OBSOLETE_CODE\}\n"
  1531.         $section appendSect [$this obsoletecode]
  1532.         $section append "\{\$ENDIF\}\n"
  1533.     }
  1534. }
  1535.  
  1536. # Do not delete this line -- regeneration end marker
  1537.  
  1538. method DPClass::addGlobvar {this newGlobvar} {
  1539.     [$this globvarSet] append $newGlobvar
  1540.  
  1541. }
  1542.  
  1543. method DPClass::removeGlobvar {this oldGlobvar} {
  1544.     [$this globvarSet] removeValue $oldGlobvar
  1545. }
  1546.  
  1547. method DPClass::addAssocvar {this newAssocvar} {
  1548.     [$this assocvarSet] append $newAssocvar
  1549.  
  1550. }
  1551.  
  1552. method DPClass::removeAssocvar {this oldAssocvar} {
  1553.     [$this assocvarSet] removeValue $oldAssocvar
  1554. }
  1555.  
  1556. method DPClass::addUservar {this newUservar} {
  1557.     [$this uservarSet] append $newUservar
  1558.  
  1559. }
  1560.  
  1561. method DPClass::removeUservar {this oldUservar} {
  1562.     [$this uservarSet] removeValue $oldUservar
  1563. }
  1564.  
  1565. method DPClass::addGenmethod {this newGenmethod} {
  1566.     [$this genmethodSet] append $newGenmethod
  1567.  
  1568. }
  1569.  
  1570. method DPClass::removeGenmethod {this oldGenmethod} {
  1571.     [$this genmethodSet] removeValue $oldGenmethod
  1572. }
  1573.  
  1574. method DPClass::addAssocgenmethod {this newAssocgenmethod} {
  1575.     [$this assocgenmethodSet] append $newAssocgenmethod
  1576.  
  1577. }
  1578.  
  1579. method DPClass::removeAssocgenmethod {this oldAssocgenmethod} {
  1580.     [$this assocgenmethodSet] removeValue $oldAssocgenmethod
  1581. }
  1582.  
  1583. method DPClass::addEvent {this newEvent} {
  1584.     [$this eventSet] append $newEvent
  1585.  
  1586. }
  1587.  
  1588. method DPClass::removeEvent {this oldEvent} {
  1589.     [$this eventSet] removeValue $oldEvent
  1590. }
  1591.  
  1592. method DPClass::addSuperinterface {this newSuperinterface} {
  1593.     [$this superinterfaceSet] append $newSuperinterface
  1594.  
  1595. }
  1596.  
  1597. method DPClass::removeSuperinterface {this oldSuperinterface} {
  1598.     [$this superinterfaceSet] removeValue $oldSuperinterface
  1599. }
  1600.  
  1601. method DPClass::addProperty {this newProperty} {
  1602.     [$this propertySet] append $newProperty
  1603.  
  1604. }
  1605.  
  1606. method DPClass::removeProperty {this oldProperty} {
  1607.     [$this propertySet] removeValue $oldProperty
  1608. }
  1609.  
  1610. method DPClass::addUsermethod {this newUsermethod} {
  1611.     [$this usermethodSet] append $newUsermethod
  1612.  
  1613. }
  1614.  
  1615. method DPClass::removeUsermethod {this oldUsermethod} {
  1616.     [$this usermethodSet] removeValue $oldUsermethod
  1617. }
  1618.  
  1619. #---------------------------------------------------------------------------
  1620. #      File:           @(#)dpenumunit.tcl    /main/titanic/2
  1621. #---------------------------------------------------------------------------
  1622.  
  1623. # Start user added include file section
  1624. # End user added include file section
  1625.  
  1626.  
  1627. Class DPEnumUnit : {DPUnit} {
  1628.     constructor
  1629.     method destructor
  1630.     method generateDeclaration
  1631.     method addComponent
  1632.     method removeComponent
  1633.     attribute unitType
  1634.     attribute isSet
  1635.     attribute componentSet
  1636. }
  1637.  
  1638. constructor DPEnumUnit {class this} {
  1639.     set this [DPUnit::constructor $class $this]
  1640.     $this unitType "enum"
  1641.     $this isSet 0
  1642.     $this componentSet [List new]
  1643.     # Start constructor user section
  1644.     # End constructor user section
  1645.     return $this
  1646. }
  1647.  
  1648. method DPEnumUnit::destructor {this} {
  1649.     # Start destructor user section
  1650.     # End destructor user section
  1651.     $this DPUnit::destructor
  1652. }
  1653.  
  1654. method DPEnumUnit::generateDeclaration {this section} {
  1655.  
  1656.     $section indent +
  1657.     $section append "[$this name] = "
  1658.     if {[$this isSet]} {
  1659.         $section append "set of "
  1660.     }
  1661.     $section append "("
  1662.     set first 1
  1663.     [$this componentSet] foreach component {
  1664.         if {$first} {
  1665.             set first 0
  1666.         } else {
  1667.             $section append ", "
  1668.         }
  1669.         $component generate $section
  1670.     }
  1671.     $section append ");\n"
  1672.     $section indent -
  1673. }
  1674.  
  1675. # Do not delete this line -- regeneration end marker
  1676.  
  1677. method DPEnumUnit::addComponent {this newComponent} {
  1678.     [$this componentSet] append $newComponent
  1679.  
  1680. }
  1681.  
  1682. method DPEnumUnit::removeComponent {this oldComponent} {
  1683.     [$this componentSet] removeValue $oldComponent
  1684. }
  1685.  
  1686. #---------------------------------------------------------------------------
  1687. #      File:           @(#)dpformclas.tcl    /main/titanic/2
  1688. #---------------------------------------------------------------------------
  1689.  
  1690. # Start user added include file section
  1691. # End user added include file section
  1692.  
  1693.  
  1694. Class DPFormClass : {DPClass} {
  1695.     constructor
  1696.     method destructor
  1697.     method generateForm
  1698.     method form
  1699.     attribute unitType
  1700.     attribute formType
  1701.     attribute _form
  1702.     attribute formvar
  1703. }
  1704.  
  1705. constructor DPFormClass {class this form} {
  1706.     set this [DPClass::constructor $class $this]
  1707.     $this unitType "formclass"
  1708.     $this formType "form"
  1709.     $this _form $form
  1710.     $form _class $this
  1711.     # Start constructor user section
  1712.     # End constructor user section
  1713.     return $this
  1714. }
  1715.  
  1716. method DPFormClass::destructor {this} {
  1717.     # Start destructor user section
  1718.     # End destructor user section
  1719.     $this DPClass::destructor
  1720. }
  1721.  
  1722. method DPFormClass::generateForm {this section} {
  1723.     [$this form] generateComponent $section
  1724. }
  1725.  
  1726. # Do not delete this line -- regeneration end marker
  1727.  
  1728. method DPFormClass::form {this args} {
  1729.     if {$args == ""} {
  1730.         return [$this _form]
  1731.     }
  1732.     set ref [$this _form]
  1733.     if {$ref != ""} {
  1734.         $ref _class ""
  1735.     }
  1736.     set obj [lindex $args 0]
  1737.     if {$obj != ""} {
  1738.         $obj _class $this
  1739.     }
  1740.     $this _form $obj
  1741. }
  1742.  
  1743. #---------------------------------------------------------------------------
  1744. #      File:           @(#)dpinterfac.tcl    /main/titanic/4
  1745. #---------------------------------------------------------------------------
  1746.  
  1747. # Start user added include file section
  1748. # End user added include file section
  1749.  
  1750.  
  1751. Class DPInterfaceUnit : {DPUnit} {
  1752.     constructor
  1753.     method destructor
  1754.     method generateDeclaration
  1755.     method addUsermethod
  1756.     method removeUsermethod
  1757.     method addProperty
  1758.     method removeProperty
  1759.     attribute unitType
  1760.     attribute interface_id
  1761.     attribute usermethodSet
  1762.     attribute propertySet
  1763.     attribute super
  1764. }
  1765.  
  1766. constructor DPInterfaceUnit {class this} {
  1767.     set this [DPUnit::constructor $class $this]
  1768.     $this unitType "interface"
  1769.     $this usermethodSet [List new]
  1770.     $this propertySet [List new]
  1771.     # Start constructor user section
  1772.     # End constructor user section
  1773.     return $this
  1774. }
  1775.  
  1776. method DPInterfaceUnit::destructor {this} {
  1777.     # Start destructor user section
  1778.     # End destructor user section
  1779.     $this DPUnit::destructor
  1780. }
  1781.  
  1782. method DPInterfaceUnit::generateDeclaration {this section} {
  1783.  
  1784.     $section indent +
  1785.     if {[$this comment] != ""} {
  1786.         [$this comment] generate $section
  1787.     }
  1788.  
  1789.     $section append "[$this name] = interface"
  1790.  
  1791.     # Superinterface
  1792.     if {[$this super] != ""} {
  1793.         $section append "("
  1794.         [$this super] generate $section $this
  1795.         $section append ")"
  1796.     }
  1797.     # Identifier
  1798.     #
  1799.     $section append "\n"
  1800.     if {[$this interface_id] != ""} {
  1801.         $section indent +
  1802.         $section append "\['\{[$this interface_id]\}'\]\n"
  1803.     }
  1804.  
  1805.     # Methods
  1806.     #
  1807.     $section append "\n${DPCookie::userDefMethods}\n"
  1808.     [$this usermethodSet] foreach meth {
  1809.         $meth generateDeclaration $section $this
  1810.     }
  1811.  
  1812.     # Properties
  1813.     #
  1814.     $section append "\n${DPCookie::properties}\n"
  1815.     [$this propertySet] foreach prop {
  1816.         $prop generate $section $this
  1817.     }
  1818.     $section indent -
  1819.     $section append "end;\n"
  1820.     $section indent -
  1821. }
  1822.  
  1823. # Do not delete this line -- regeneration end marker
  1824.  
  1825. method DPInterfaceUnit::addUsermethod {this newUsermethod} {
  1826.     [$this usermethodSet] append $newUsermethod
  1827.  
  1828. }
  1829.  
  1830. method DPInterfaceUnit::removeUsermethod {this oldUsermethod} {
  1831.     [$this usermethodSet] removeValue $oldUsermethod
  1832. }
  1833.  
  1834. method DPInterfaceUnit::addProperty {this newProperty} {
  1835.     [$this propertySet] append $newProperty
  1836.  
  1837. }
  1838.  
  1839. method DPInterfaceUnit::removeProperty {this oldProperty} {
  1840.     [$this propertySet] removeValue $oldProperty
  1841. }
  1842.  
  1843. #---------------------------------------------------------------------------
  1844. #      File:           @(#)dptypedefu.tcl    /main/titanic/3
  1845. #---------------------------------------------------------------------------
  1846.  
  1847. # Start user added include file section
  1848. # End user added include file section
  1849.  
  1850.  
  1851. Class DPTypeDefUnit : {DPUnit} {
  1852.     constructor
  1853.     method destructor
  1854.     method generateDeclaration
  1855.     attribute unitType
  1856.     attribute typedefType
  1857. }
  1858.  
  1859. constructor DPTypeDefUnit {class this} {
  1860.     set this [DPUnit::constructor $class $this]
  1861.     $this unitType "typedef"
  1862.     # Start constructor user section
  1863.     # End constructor user section
  1864.     return $this
  1865. }
  1866.  
  1867. method DPTypeDefUnit::destructor {this} {
  1868.     # Start destructor user section
  1869.     # End destructor user section
  1870.     $this DPUnit::destructor
  1871. }
  1872.  
  1873. method DPTypeDefUnit::generateDeclaration {this section} {
  1874.     $section indent +
  1875.     $section append "[$this name] = "
  1876.     [$this typedefType] generate $section $this
  1877.     $section append ";\n"
  1878.     $section indent -
  1879. }
  1880.  
  1881. # Do not delete this line -- regeneration end marker
  1882.  
  1883. #---------------------------------------------------------------------------
  1884. #      File:           @(#)dpproperty.tcl    /main/titanic/4
  1885. #---------------------------------------------------------------------------
  1886.  
  1887. # Start user added include file section
  1888. # End user added include file section
  1889.  
  1890.  
  1891. Class DPProperty : {DPFeature} {
  1892.     constructor
  1893.     method destructor
  1894.     method generate
  1895.     attribute read
  1896.     attribute write
  1897.     attribute index
  1898.     attribute storage
  1899.     attribute usedefault
  1900.     attribute default
  1901.     attribute type
  1902. }
  1903.  
  1904. constructor DPProperty {class this type} {
  1905.     set this [DPFeature::constructor $class $this]
  1906.     $this type $type
  1907.     # Start constructor user section
  1908.     # End constructor user section
  1909.     return $this
  1910. }
  1911.  
  1912. method DPProperty::destructor {this} {
  1913.     # Start destructor user section
  1914.     # End destructor user section
  1915.     $this DPFeature::destructor
  1916. }
  1917.  
  1918. method DPProperty::generate {this whole unit} {
  1919.  
  1920.     $whole append "property "
  1921.     $whole append "[$this name]: "
  1922.     [$this type] generate $whole $unit
  1923.     if {[$this index] != ""} {
  1924.         $whole append " index [$this index]"
  1925.     }
  1926.     if {[$this read] != ""} {
  1927.         $whole append " read [$this read]"
  1928.     }
  1929.     if {[$this write] != ""} {
  1930.         $whole append " write [$this write]"
  1931.     }
  1932.     switch [$this storage] {
  1933.         "True" {
  1934.             $whole append " stored True"
  1935.         }
  1936.         "False" {
  1937.             $whole append " stored False"
  1938.         }
  1939.     }
  1940.     switch [$this usedefault] {
  1941.         "Default" {
  1942.             $whole append " default"
  1943.         }
  1944.         "No Default" {
  1945.             $whole append " nodefault"
  1946.         }
  1947.     }
  1948.     if {([$this default] != "") && ([$this usedefault] == "Default")} {
  1949.         $whole append " [$this default]"
  1950.     }
  1951.     $whole append ";\n"
  1952. }
  1953.  
  1954. # Do not delete this line -- regeneration end marker
  1955.  
  1956. #---------------------------------------------------------------------------
  1957. #      File:           @(#)dpfunction.tcl    /main/titanic/1
  1958. #---------------------------------------------------------------------------
  1959.  
  1960. # Start user added include file section
  1961. # End user added include file section
  1962.  
  1963.  
  1964. Class DPFunction : {DPMethod} {
  1965.     constructor
  1966.     method destructor
  1967.     method generateReturnType
  1968.     attribute methodType
  1969.     attribute returnvalue
  1970. }
  1971.  
  1972. constructor DPFunction {class this returnvalue} {
  1973.     set this [DPMethod::constructor $class $this]
  1974.     $this methodType "function"
  1975.     $this returnvalue $returnvalue
  1976.     # Start constructor user section
  1977.     # End constructor user section
  1978.     return $this
  1979. }
  1980.  
  1981. method DPFunction::destructor {this} {
  1982.     # Start destructor user section
  1983.     # End destructor user section
  1984.     $this DPMethod::destructor
  1985. }
  1986.  
  1987. method DPFunction::generateReturnType {this whole unit} {
  1988.     $whole append ": "
  1989.     [$this returnvalue] generate $whole $unit
  1990. }
  1991. #endif
  1992.  
  1993. # Do not delete this line -- regeneration end marker
  1994.  
  1995. #---------------------------------------------------------------------------
  1996. #      File:           @(#)dpform.tcl    /main/titanic/3
  1997. #---------------------------------------------------------------------------
  1998.  
  1999. # Start user added include file section
  2000. # End user added include file section
  2001.  
  2002.  
  2003. Class DPForm : {DPControl} {
  2004.     constructor
  2005.     method destructor
  2006.     method class
  2007.     method getControl
  2008.     method setControl
  2009.     method removeControl
  2010.     attribute name
  2011.     attribute _class
  2012.     attribute control
  2013. }
  2014.  
  2015. constructor DPForm {class this type} {
  2016.     set this [DPControl::constructor $class $this $type]
  2017.     $this control [Dictionary new]
  2018.     # Start constructor user section
  2019.     # End constructor user section
  2020.     return $this
  2021. }
  2022.  
  2023. method DPForm::destructor {this} {
  2024.     # Start destructor user section
  2025.     # End destructor user section
  2026.     $this DPControl::destructor
  2027. }
  2028.  
  2029. # Do not delete this line -- regeneration end marker
  2030.  
  2031. method DPForm::class {this args} {
  2032.     if {$args == ""} {
  2033.         return [$this _class]
  2034.     }
  2035.     set ref [$this _class]
  2036.     if {$ref != ""} {
  2037.         $ref _form ""
  2038.     }
  2039.     set obj [lindex $args 0]
  2040.     if {$obj != ""} {
  2041.         $obj _form $this
  2042.     }
  2043.     $this _class $obj
  2044. }
  2045.  
  2046. method DPForm::getControl {this name} {
  2047.     return [[$this control] set $name]
  2048. }
  2049.  
  2050. method DPForm::setControl {this name newControl} {
  2051.     [$this control] set $name $newControl
  2052. }
  2053.  
  2054. method DPForm::removeControl {this name} {
  2055.     [$this control] unset $name
  2056. }
  2057.  
  2058. #---------------------------------------------------------------------------
  2059. #      File:           @(#)dpconstruc.tcl    /main/titanic/1
  2060. #---------------------------------------------------------------------------
  2061.  
  2062. # Start user added include file section
  2063. # End user added include file section
  2064.  
  2065.  
  2066. Class DPConstructor : {DPProcedure} {
  2067.     constructor
  2068.     method destructor
  2069.     attribute methodType
  2070.     attribute hasUserSection
  2071. }
  2072.  
  2073. constructor DPConstructor {class this} {
  2074.     set this [DPProcedure::constructor $class $this]
  2075.     $this methodType "constructor"
  2076.     $this hasUserSection 1
  2077.     # Start constructor user section
  2078.     # End constructor user section
  2079.     return $this
  2080. }
  2081.  
  2082. method DPConstructor::destructor {this} {
  2083.     # Start destructor user section
  2084.     # End destructor user section
  2085.     $this DPProcedure::destructor
  2086. }
  2087.  
  2088. # Do not delete this line -- regeneration end marker
  2089.  
  2090. #---------------------------------------------------------------------------
  2091. #      File:           @(#)dpdestruct.tcl    /main/titanic/1
  2092. #---------------------------------------------------------------------------
  2093.  
  2094. # Start user added include file section
  2095. # End user added include file section
  2096.  
  2097.  
  2098. Class DPDestructor : {DPProcedure} {
  2099.     constructor
  2100.     method destructor
  2101.     attribute methodType
  2102.     attribute hasUserSection
  2103. }
  2104.  
  2105. constructor DPDestructor {class this} {
  2106.     set this [DPProcedure::constructor $class $this]
  2107.     $this methodType "destructor"
  2108.     $this hasUserSection 1
  2109.     # Start constructor user section
  2110.     # End constructor user section
  2111.     return $this
  2112. }
  2113.  
  2114. method DPDestructor::destructor {this} {
  2115.     # Start destructor user section
  2116.     # End destructor user section
  2117.     $this DPProcedure::destructor
  2118. }
  2119.  
  2120. # Do not delete this line -- regeneration end marker
  2121.  
  2122.