home *** CD-ROM | disk | FTP | other *** search
Text File | 1997-05-07 | 42.2 KB | 1,719 lines |
- #---------------------------------------------------------------------------
- #
- # Copyright (c) 1997 by Cayenne Software, Inc.
- #
- # This software is furnished under a license and may be used only in
- # accordance with the terms of such license and with the inclusion of
- # the above copyright notice. This software or any other copies thereof
- # may not be provided or otherwise made available to any other person.
- # No title to and ownership of the software is hereby transferred.
- #
- # The information in this software is subject to change without notice
- # and should not be construed as a commitment by Cayenne Software, Inc.
- #
- #---------------------------------------------------------------------------
- #
- # File : delphitgt.tcl
- # Author :
- # Original date : May 1997
- # Description : Classes for code generation
- #
- #---------------------------------------------------------------------------
-
- #---------------------------------------------------------------------------
- # File: @(#)dpargument.tcl /main/hindenburg/4
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class DPArgument : {GCObject} {
- constructor
- method destructor
- method generate
- attribute name
- attribute passedBy
- attribute type
- }
-
- constructor DPArgument {class this type} {
- set this [GCObject::constructor $class $this]
- $this type $type
- # Start constructor user section
- # End constructor user section
- return $this
- }
-
- method DPArgument::destructor {this} {
- # Start destructor user section
- # End destructor user section
- }
-
- method DPArgument::generate {this whole unit} {
- switch [$this passedBy] {
- "Variable" {
- $whole append "var "
- }
- "Constant" {
- $whole append "const "
- }
- }
- $whole append "[$this name]: "
- [$this type] generate $whole $unit
- }
-
- # Do not delete this line -- regeneration end marker
-
- #---------------------------------------------------------------------------
- # File: @(#)dpcomment.tcl /main/hindenburg/1
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class DPComment : {GCObject} {
- constructor
- method destructor
- method generate
- attribute comment
- }
-
- constructor DPComment {class this} {
- set this [GCObject::constructor $class $this]
- # Start constructor user section
- # End constructor user section
- return $this
- }
-
- method DPComment::destructor {this} {
- # Start destructor user section
- # End destructor user section
- }
-
- method DPComment::generate {this whole} {
- if { [string length [$this comment]] > 0 } {
- set restComment [$this comment]
- set newlinePos [string first "\n" $restComment ]
- while {$newlinePos != -1} {
- set thisline [string range $restComment 0 [expr $newlinePos - 1]]
- set restComment \
- [string range $restComment [expr $newlinePos + 1] end]
- set newlinePos [string first "\n" $restComment ]
- $whole append "// $thisline\n"
- }
- $whole append "// $restComment\n"
- }
-
- }
-
- # Do not delete this line -- regeneration end marker
-
- #---------------------------------------------------------------------------
- # File: @(#)dpcontrole.tcl /main/hindenburg/2
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class DPControlEvent : {GCObject} {
- constructor
- method destructor
- method generate
- attribute name
- attribute method
- }
-
- constructor DPControlEvent {class this method} {
- set this [GCObject::constructor $class $this]
- $this method $method
- # Start constructor user section
- # End constructor user section
- return $this
- }
-
- method DPControlEvent::destructor {this} {
- # Start destructor user section
- # End destructor user section
- }
-
- method DPControlEvent::generate {this section} {
- if {![regexp ^(after|before) [string tolower [$this name]]]} {
- $section append "On"
- }
- $section append [$this name]
- $section append " = "
- $section append [[$this method] name]
- $section append "\n"
- }
-
- # Do not delete this line -- regeneration end marker
-
- #---------------------------------------------------------------------------
- # File: @(#)dpcookie.tcl /main/hindenburg/4
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class DPCookie : {GCObject} {
- constructor
- method destructor
- }
-
- global DPCookie::controls
- set DPCookie::controls "// Visual Components"
-
- global DPCookie::events
- set DPCookie::events "// Events"
-
- global DPCookie::properties
- set DPCookie::properties "// Properties"
-
- global DPCookie::implement0
- set DPCookie::implement0 "// !! Implement this method !!"
-
- global DPCookie::startUserSection
- set DPCookie::startUserSection "// Start user section"
-
- global DPCookie::endUserSection
- set DPCookie::endUserSection "// End user section"
-
- global DPCookie::startUserInclude
- set DPCookie::startUserInclude "// Start user include section"
-
- global DPCookie::endUserInclude
- set DPCookie::endUserInclude "// End user include section"
-
- global DPCookie::assocAttribs
- set DPCookie::assocAttribs "// Association attributes"
-
- global DPCookie::userDefAttribs
- set DPCookie::userDefAttribs "// User defined attributes"
-
- global DPCookie::formAttrib
- set DPCookie::formAttrib "// Form attribute"
-
- global DPCookie::userDefMethods
- set DPCookie::userDefMethods "// User defined methods"
-
- global DPCookie::accessMethods
- set DPCookie::accessMethods "// Access methods"
-
- global DPCookie::assocMethods
- set DPCookie::assocMethods "// Association methods"
-
- global DPCookie::classFeatureAttribs
- set DPCookie::classFeatureAttribs "// Class feature attributes"
-
- global DPCookie::classFeatureMethods
- set DPCookie::classFeatureMethods "// Class feature methods"
-
- global DPCookie::regenMarker
- set DPCookie::regenMarker "// Do not delete this line -- regeneration marker"
-
- global DPCookie::obsoleteCode
- set DPCookie::obsoleteCode "// Obsolete code section"
-
- global DPCookie::genProjectInclude
- set DPCookie::genProjectInclude "// Generated"
-
- global DPCookie::genProjectCode
- set DPCookie::genProjectCode "// Generated"
-
- global DPCookie::genProjectStart
- set DPCookie::genProjectStart "// Do not delete this block -- regeneration marker -- start"
-
- global DPCookie::genProjectEnd
- set DPCookie::genProjectEnd "// Do not delete this block -- regeneration marker -- end"
-
-
- constructor DPCookie {class this} {
- set this [GCObject::constructor $class $this]
- # Start constructor user section
- # End constructor user section
- return $this
- }
-
- method DPCookie::destructor {this} {
- # Start destructor user section
- # End destructor user section
- }
-
- # Do not delete this line -- regeneration end marker
-
- #---------------------------------------------------------------------------
- # File: @(#)dpenumcomp.tcl /main/hindenburg/1
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class DPEnumComponent : {GCObject} {
- constructor
- method destructor
- method generate
- attribute name
- }
-
- constructor DPEnumComponent {class this} {
- set this [GCObject::constructor $class $this]
- # Start constructor user section
- # End constructor user section
- return $this
- }
-
- method DPEnumComponent::destructor {this} {
- # Start destructor user section
- # End destructor user section
- }
-
- method DPEnumComponent::generate {this section} {
- $section append [$this name]
- }
-
- # Do not delete this line -- regeneration end marker
-
- #---------------------------------------------------------------------------
- # File: @(#)dpfeature.tcl /main/hindenburg/3
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class DPFeature : {GCObject} {
- constructor
- method destructor
- attribute name
- attribute access
- attribute isClassFeature
- attribute comment
- }
-
- constructor DPFeature {class this} {
- set this [GCObject::constructor $class $this]
- $this access "Published"
- $this isClassFeature 0
- # Start constructor user section
- # End constructor user section
- return $this
- }
-
- method DPFeature::destructor {this} {
- # Start destructor user section
- # End destructor user section
- }
-
- # Do not delete this line -- regeneration end marker
-
- #---------------------------------------------------------------------------
- # File: @(#)dpproject.tcl /main/hindenburg/4
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class DPProject : {GCObject} {
- constructor
- method destructor
- method generate
- method generateFile
- method getUnit
- method setUnit
- method removeUnit
- method getForm
- method setForm
- method removeForm
- attribute name
- attribute isLibrary
- attribute unit
- attribute form
- }
-
- constructor DPProject {class this} {
- set this [GCObject::constructor $class $this]
- $this isLibrary 0
- $this unit [Dictionary new]
- $this form [Dictionary new]
- # Start constructor user section
- # End constructor user section
- return $this
- }
-
- method DPProject::destructor {this} {
- # Start destructor user section
- # End destructor user section
- }
-
- method DPProject::generate {this typeToClassDict} {
-
- $typeToClassDict foreach ooplclass fileDict {
- if {[[$this unit] exists [$ooplclass getName]]} {
- set unitfile [TextSection new]
- [[$this unit] set [$ooplclass getName]] generate $unitfile
- $fileDict set "pas" $unitfile
- if {[[[$this unit] set [$ooplclass getName]] unitType] == "formclass"} {
- set formfile [TextSection new]
- [[$this unit] set [$ooplclass getName]] generateForm $formfile
- $fileDict set "txt" $formfile
- }
- }
- }
- }
-
- method DPProject::generateFile {this section} {
- if {[$this isLibrary]} {
- $section append "library "
- } else {
- $section append "program "
- }
- $section append [$this name]
- $section append ";\n\nuses\n"
- $section indent +
- if {![$this isLibrary]} {
- $section append "Forms,\n"
- }
-
- set first 1
- [$this unit] foreach key unt {
- if {$first} {
- set first 0
- } else {
- $section append ",\n"
- }
- $section append [$unt name]
- $section append " in \""
- $section append [[$unt delphiclass] name]
- $section append ".pas\""
- }
-
- $section append ";\n\n"
- $section indent -
-
- if {![$this isLibrary]} {
- $section append "\{\$R \*.RES\}\n\n"
- }
- $section append "begin\n"
- if {![$this isLibrary]} {
- $section indent +
- $section append "Application.Initialize;\n"
-
- [$this form] foreach key frm {
- $section append "Application.CreateForm\("
- $section append [[$frm type] name]
- $section append ", "
- $section append [$frm name]
- $section append "\);\n"
- }
-
- $section append "Application.Run\n"
- $section indent -
- }
- $section append "end.\n"
- }
-
- # Do not delete this line -- regeneration end marker
-
- method DPProject::getUnit {this name} {
- return [[$this unit] set $name]
- }
-
- method DPProject::setUnit {this name newUnit} {
- [$this unit] set $name $newUnit
- }
-
- method DPProject::removeUnit {this name} {
- [$this unit] unset $name
- }
-
- method DPProject::getForm {this name} {
- return [[$this form] set $name]
- }
-
- method DPProject::setForm {this name newForm} {
- [$this form] set $name $newForm
- }
-
- method DPProject::removeForm {this name} {
- [$this form] unset $name
- }
-
- #---------------------------------------------------------------------------
- # File: @(#)dptype.tcl /main/hindenburg/5
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class DPType : {GCObject} {
- constructor
- method destructor
- method addAsInclude
- method generate
- attribute name
- attribute isArray
- attribute arraySize
- attribute includeType
- attribute includeName
- }
-
- constructor DPType {class this} {
- set this [GCObject::constructor $class $this]
- $this isArray 0
- $this includeType "none"
- # Start constructor user section
- # End constructor user section
- return $this
- }
-
- method DPType::destructor {this} {
- # Start destructor user section
- # End destructor user section
- }
-
- method DPType::addAsInclude {this unit} {
- switch [$this includeType] {
- "user" {
- $unit addInclude [$this includeName]
- }
- "imp" {
- $unit addImpinclude [$this includeName]
- }
- "system" {
- $unit addSysteminclude [$this includeName]
- }
- "none" {
- }
- default {
- }
- }
- }
-
- method DPType::generate {this whole unit} {
- if {[$this isArray]} {
- $whole append "array[1.."
- $whole append [$this arraySize]
- $whole append "] of "
- }
- $whole append [$this name]
- $this addAsInclude $unit
- }
-
- # Do not delete this line -- regeneration end marker
-
- #---------------------------------------------------------------------------
- # File: @(#)dpunit.tcl /main/hindenburg/8
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class DPUnit : {GCObject} {
- constructor
- method destructor
- method addInclude
- method addSysteminclude
- method addImpinclude
- method generateDeclaration
- method generateMethods
- method generateIncludes
- method generateImpIncludes
- method generate
- attribute name
- attribute unitName
- attribute unitType
- attribute includeSet
- attribute comment
- attribute systemincludeSet
- attribute userinclude
- attribute impincludeSet
- }
-
- constructor DPUnit {class this} {
- set this [GCObject::constructor $class $this]
- $this unitType "none"
- $this includeSet [List new]
- $this systemincludeSet [List new]
- $this impincludeSet [List new]
- # Start constructor user section
- # End constructor user section
- return $this
- }
-
- method DPUnit::destructor {this} {
- # Start destructor user section
- # End destructor user section
- }
-
- method DPUnit::addInclude {this unit} {
- if {$unit == ""} {
- return
- }
- if {[[$this impincludeSet] search -exact $unit] != -1} {
- [$this impincludeSet] removeValue $unit
- }
- if {$unit != [$this unitName] && [[$this includeSet] search -exact $unit] == -1} {
- [$this includeSet] insert $unit
- }
- }
-
- method DPUnit::addSysteminclude {this unit} {
- if {$unit == ""} {
- return
- }
- if {$unit != [$this unitName] && [[$this systemincludeSet] search -exact $unit] == -1} {
- if {$unit != "System"} {
- [$this systemincludeSet] insert $unit
- }
- }
- }
-
- method DPUnit::addImpinclude {this unit} {
- if {$unit == ""} {
- return
- }
- if {$unit != [$this unitName] && [[$this impincludeSet] search -exact $unit] == -1 && [[$this includeSet] search -exact $unit] == -1} {
- [$this impincludeSet] insert $unit
- }
- }
-
- method DPUnit::generateDeclaration {this section} {
- # !! Implement this function !!
- }
-
- method DPUnit::generateMethods {this section} {
- $section append "${DPCookie::regenMarker}\n\n"
- }
-
- method DPUnit::generateIncludes {this section} {
-
- set first 1
- if {[$this userinclude] != "" || ![[$this includeSet] empty] || ![[$this systemincludeSet] empty]} {
- $section append "uses\n"
- $section indent +
-
- # Uses
- #
- $section append "${DPCookie::startUserInclude}\n"
-
- if {[$this userinclude] != ""} {
- set usesList [split [[$this userinclude] contents] "\n"]
-
- set oldremain ""
- foreach line $usesList {
- if {[regexp {^[ ]*([^ ,;]+)([,;])?([ ]*.*)$} $line total name dummy remain]} {
- if {$first} {
- set first 0
- } else {
- $section append ","
- $section append "${oldremain}\n"
- }
- set oldremain $remain
- $section append "${name}"
- }
- }
- if {!$first} {
- if {![[$this includeSet] empty] || ![[$this systemincludeSet] empty]} {
- $section append ","
- }
- $section append "${remain}\n"
- }
- }
- $section append "${DPCookie::endUserInclude}\n"
-
- set first 1
- if {![[$this systemincludeSet] empty]} {
- [$this systemincludeSet] foreach include {
- if {$first} {
- set first 0
- } else {
- $section append ",\n"
- }
- $section append "${include}"
- }
- }
- if {![[$this includeSet] empty]} {
- [$this includeSet] foreach include {
- if {$first} {
- set first 0
- } else {
- $section append ",\n"
- }
- $section append "${include}"
- }
- }
- $section append ";\n\n"
- $section indent -
- }
- }
-
- method DPUnit::generateImpIncludes {this section} {
- set first 1
- if {![[$this impincludeSet] empty]} {
- $section append "uses\n"
- $section indent +
-
- # Uses
- #
- set first 1
- if {![[$this impincludeSet] empty]} {
- [$this impincludeSet] foreach include {
- if {$first} {
- set first 0
- } else {
- $section append ",\n"
- }
- $section append "${include}"
- }
- }
- $section append ";\n\n"
- $section indent -
- }
- }
-
- method DPUnit::generate {this section} {
-
- set declSection [TextSection new]
- set defSection [TextSection new]
- set inclSection [TextSection new]
- set impInclSection [TextSection new]
-
- # Declaration part
- $this generateDeclaration $declSection
-
- # Definition part
- $this generateMethods $defSection
-
- # Includes part
- $this generateIncludes $inclSection
-
- # Implementation includes part
- $this generateImpIncludes $impInclSection
-
- $section append "unit [$this unitName];\n\n"
-
- $section append "interface\n\n"
- $section appendSect $inclSection
- $section append "type\n"
- $section appendSect $declSection
-
- $section append "\n\nimplementation\n\n"
- $section appendSect $impInclSection
- $section appendSect $defSection
-
- $section append "\nend.\n"
- }
-
- # Do not delete this line -- regeneration end marker
-
- #---------------------------------------------------------------------------
- # File: @(#)dpvariable.tcl /main/hindenburg/4
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class DPVariable : {DPFeature} {
- constructor
- method destructor
- method generate
- method addProc
- method removeProc
- attribute type
- attribute procSet
- }
-
- constructor DPVariable {class this type} {
- set this [DPFeature::constructor $class $this]
- $this type $type
- $this procSet [List new]
- # Start constructor user section
- # End constructor user section
- return $this
- }
-
- method DPVariable::destructor {this} {
- # Start destructor user section
- # End destructor user section
- $this DPFeature::destructor
- }
-
- method DPVariable::generate {this whole unit} {
- if {[$this comment] != ""} {
- [$this comment] generate $whole
- }
- $whole append "[$this name]: "
- [$this type] generate $whole $unit
- $whole append ";\n"
- }
-
- # Do not delete this line -- regeneration end marker
-
- method DPVariable::addProc {this newProc} {
- [$this procSet] append $newProc
-
- }
-
- method DPVariable::removeProc {this oldProc} {
- [$this procSet] removeValue $oldProc
- }
- #---------------------------------------------------------------------------
- # File: @(#)dpcontrol.tcl /main/hindenburg/3
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class DPControl : {DPVariable} {
- constructor
- method destructor
- method generateComponent
- method addEvent
- method removeEvent
- method addChild
- method removeChild
- attribute properties
- attribute eventSet
- attribute childSet
- }
-
- constructor DPControl {class this type} {
- set this [DPVariable::constructor $class $this $type]
- $this eventSet [List new]
- $this childSet [List new]
- # Start constructor user section
- # End constructor user section
- return $this
- }
-
- method DPControl::destructor {this} {
- # Start destructor user section
- # End destructor user section
- $this DPVariable::destructor
- }
-
- method DPControl::generateComponent {this section} {
- $section append "object "
- $section append "[$this name]: [[$this type] name]\n"
- $section indent +
- [$this eventSet] foreach event {
- $event generate $section
- }
- if {[$this properties] != ""} {
- $section appendSect [$this properties]
- }
- [$this childSet] foreach child {
- $child generateComponent $section
- }
- $section indent -
- $section append "end\n"
- }
-
- # Do not delete this line -- regeneration end marker
-
- method DPControl::addEvent {this newEvent} {
- [$this eventSet] append $newEvent
-
- }
-
- method DPControl::removeEvent {this oldEvent} {
- [$this eventSet] removeValue $oldEvent
- }
-
- method DPControl::addChild {this newChild} {
- [$this childSet] append $newChild
-
- }
-
- method DPControl::removeChild {this oldChild} {
- [$this childSet] removeValue $oldChild
- }
-
- #---------------------------------------------------------------------------
- # File: @(#)dpmethod.tcl /main/hindenburg/6
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class DPMethod : {DPFeature} {
- constructor
- method destructor
- method generateTypes
- method generateGenCode
- method generateUserCode
- method generateReturnType
- method generateArguments
- method generateDeclaration
- method generateDefinition
- method generate
- method addArg
- method removeArg
- attribute methodType
- attribute userCodeFirst
- attribute hasUserSection
- attribute isVirtual
- attribute isDynamic
- attribute isAbstract
- attribute isOverride
- attribute usercode
- attribute gencode
- attribute gentypes
- attribute usertypes
- attribute argSet
- }
-
- constructor DPMethod {class this} {
- set this [DPFeature::constructor $class $this]
- $this methodType "None"
- $this userCodeFirst 0
- $this hasUserSection 0
- $this isVirtual 0
- $this isDynamic 0
- $this isAbstract 0
- $this isOverride 0
- $this argSet [List new]
- # Start constructor user section
- # End constructor user section
- return $this
- }
-
- method DPMethod::destructor {this} {
- # Start destructor user section
- # End destructor user section
- $this DPFeature::destructor
- }
-
- method DPMethod::generateTypes {this whole} {
- if {[$this gentypes] != ""} {
- $whole appendSect [$this gentypes]
- }
- if {[$this hasUserSection]} {
- $whole indent +
- $whole append "${DPCookie::startUserSection}\n"
- $whole indent -
- }
- if {[$this usertypes] != ""} {
- $whole appendSect [$this usertypes]
- }
- if {[$this hasUserSection]} {
- $whole indent +
- $whole append "${DPCookie::endUserSection}\n"
- $whole indent -
- }
- }
-
- method DPMethod::generateGenCode {this whole} {
- $whole indent +
- if {[$this gencode] != ""} {
- $whole appendSect [$this gencode]
- } elseif {![$this hasUserSection] && [$this usercode] == ""} {
- $whole append "${DPCookie::implement0}\n"
- }
- $whole indent -
- }
-
- method DPMethod::generateUserCode {this whole} {
- if {[$this hasUserSection]} {
- $whole indent +
- $whole append "${DPCookie::startUserSection}\n"
- $whole indent -
- }
- if {[$this usercode] != ""} {
- $whole appendSect [$this usercode]
- }
- if {[$this hasUserSection]} {
- $whole indent +
- $whole append "${DPCookie::endUserSection}\n"
- $whole indent -
- }
- }
-
- method DPMethod::generateReturnType {this whole unit} {
- }
-
- method DPMethod::generateArguments {this whole unit} {
-
- if {[[$this argSet] contents] != ""} {
- $whole append "("
- set first 1
- [$this argSet] foreach arg {
- if {$first} {
- set first 0
- } else {
- $whole append "; "
- }
- $arg generate $whole $unit
- }
- $whole append ")"
- }
- $this generateReturnType $whole $unit
- $whole append ";"
- }
-
- method DPMethod::generateDeclaration {this whole unit} {
- if {[$this isClassFeature]} {
- $whole append "class "
- }
- $whole append "[$this methodType] [$this name]"
- $this generateArguments $whole $unit
-
- if {[$this isOverride]} {
- $whole append " override;"
- }
- if {[$this isVirtual]} {
- $whole append " virtual;"
- }
- if {[$this isDynamic]} {
- $whole append " dynamic;"
- }
- if {[$this isAbstract]} {
- $whole append " abstract;"
- }
- $whole append "\n"
- }
-
- method DPMethod::generateDefinition {this whole unit} {
- if {[$this isClassFeature]} {
- $whole append "class "
- }
- $whole append "[$this methodType] [$unit name].[$this name]"
-
- $this generateArguments $whole $unit
- }
-
- method DPMethod::generate {this whole unit} {
- if {[$this comment] != ""} {
- [$this comment] generate $whole
- }
- $this generateDefinition $whole $unit
-
- $whole append "\n"
-
- $this generateTypes $whole
- $whole append "begin\n"
-
- if {[$this userCodeFirst]} {
- $this generateUserCode $whole
- $this generateGenCode $whole
- } else {
- $this generateGenCode $whole
- $this generateUserCode $whole
- }
- $whole append "end;\n\n\n"
- }
-
- # Do not delete this line -- regeneration end marker
-
- method DPMethod::addArg {this newArg} {
- [$this argSet] append $newArg
-
- }
-
- method DPMethod::removeArg {this oldArg} {
- [$this argSet] removeValue $oldArg
- }
-
- #---------------------------------------------------------------------------
- # File: @(#)dpprocedur.tcl /main/hindenburg/1
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class DPProcedure : {DPMethod} {
- constructor
- method destructor
- attribute methodType
- }
-
- constructor DPProcedure {class this} {
- set this [DPMethod::constructor $class $this]
- $this methodType "procedure"
- # Start constructor user section
- # End constructor user section
- return $this
- }
-
- method DPProcedure::destructor {this} {
- # Start destructor user section
- # End destructor user section
- $this DPMethod::destructor
- }
-
- # Do not delete this line -- regeneration end marker
-
- #---------------------------------------------------------------------------
- # File: @(#)dpevent.tcl /main/hindenburg/1
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class DPEvent : {DPProcedure} {
- constructor
- method destructor
- attribute methodType
- }
-
- constructor DPEvent {class this} {
- set this [DPProcedure::constructor $class $this]
- $this methodType "procedure"
- # Start constructor user section
- # End constructor user section
- return $this
- }
-
- method DPEvent::destructor {this} {
- # Start destructor user section
- # End destructor user section
- $this DPProcedure::destructor
- }
-
- # Do not delete this line -- regeneration end marker
-
- #---------------------------------------------------------------------------
- # File: @(#)dpclass.tcl /main/hindenburg/9
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class DPClass : {DPUnit} {
- constructor
- method destructor
- method generateGlobVars
- method generateDeclaration
- method generateMethods
- method addGlobvar
- method removeGlobvar
- method addAssocvar
- method removeAssocvar
- method addUservar
- method removeUservar
- method addProperty
- method removeProperty
- method getGenmethod
- method setGenmethod
- method removeGenmethod
- method getUsermethod
- method setUsermethod
- method removeUsermethod
- method getEvent
- method setEvent
- method removeEvent
- attribute unitType
- attribute userConstructors
- attribute destructr
- attribute constructr
- attribute superclass
- attribute globvarSet
- attribute assocvarSet
- attribute uservarSet
- attribute obsoletecode
- attribute propertySet
- attribute genmethod
- attribute usermethod
- attribute event
- }
-
- constructor DPClass {class this} {
- set this [DPUnit::constructor $class $this]
- $this unitType "class"
- $this userConstructors 0
- $this globvarSet [List new]
- $this assocvarSet [List new]
- $this uservarSet [List new]
- $this propertySet [List new]
- $this genmethod [Dictionary new]
- $this usermethod [Dictionary new]
- $this event [Dictionary new]
- # Start constructor user section
- # End constructor user section
- return $this
- }
-
- method DPClass::destructor {this} {
- # Start destructor user section
- # End destructor user section
- $this DPUnit::destructor
- }
-
- method DPClass::generateGlobVars {this section} {
- if {![[$this globvarSet] empty]} {
- $section append "\n${DPCookie::classFeatureAttribs}\n"
- $section append "var\n"
- $section indent +
- [$this globvarSet] foreach var {
- $var generate $section $this
- }
- $section indent -
- }
- }
-
- method DPClass::generateDeclaration {this section} {
-
- set sectionList {NoneSection ProtectedSection PrivateSection PublicSection PublishedSection}
-
- $section indent +
- if {[$this comment] != ""} {
- [$this comment] generate $section
- }
-
- $section append "[$this name] = class"
-
- # Generate superclass
- if {[$this superclass] != ""} {
- $section append "("
- [$this superclass] generate $section $this
- $section append ")"
- }
- $section append "\n"
-
- if {[$this unitType] == "formclass"} {
- $section indent +
- $section append "\n${DPCookie::controls}\n"
- [[$this form] control] foreach key control {
- $control generate $section $this
- }
- $section append "\n${DPCookie::events}\n"
- [$this event] foreach key evt {
- $evt generateDeclaration $section $this
- }
- $section indent -
- }
-
- # Create access sections
- #
- foreach sec $sectionList {
- set $sec [TextSection new]
- [set $sec] indent +
- }
-
- # User defined attributes
- #
- $PrivateSection append "\n${DPCookie::userDefAttribs}\n"
- [$this uservarSet] foreach var {
- $var generate [set [$var access]Section] $this
- }
-
- # Association attributes
- #
- $PrivateSection append "\n${DPCookie::assocAttribs}\n"
- [$this assocvarSet] foreach var {
- $var generate [set [$var access]Section] $this
- }
-
- # User methods
- #
- foreach sec $sectionList {
- [set $sec] append "\n${DPCookie::userDefMethods}\n"
- }
- # Constructor
- if {[$this constructr] != ""} {
- [$this constructr] generateDeclaration [set [[$this constructr] access]Section] $this
- }
- # Destructor
- if {[$this destructr] != ""} {
- [$this destructr] generateDeclaration [set [[$this destructr] access]Section] $this
- }
-
- [$this usermethod] foreach key method {
- $method generateDeclaration [set [$method access]Section] $this
- }
-
- # Access methods
- #
- foreach sec $sectionList {
- [set $sec] append "\n${DPCookie::accessMethods}\n"
- }
- [$this genmethod] foreach key method {
- $method generateDeclaration [set [$method access]Section] $this
- }
-
- # Properties
- #
- foreach sec $sectionList {
- [set $sec] append "\n${DPCookie::properties}\n"
- }
- [$this propertySet] foreach prop {
- $prop generate [set [$prop access]Section] $this
- }
-
- $section append "\nprivate\n"
- $section appendSect $PrivateSection
- $section append "\nprotected\n"
- $section appendSect $ProtectedSection
- $section append "\npublic\n"
- $section appendSect $PublicSection
- $section append "\npublished\n"
- $section appendSect $PublishedSection
- $section append "end;\n"
- $section indent -
-
- $this generateGlobVars $section
- }
-
- method DPClass::generateMethods {this section} {
-
- if {[$this unitType] == "formclass"} {
- $section append "\{\$R \*.DFM\}\n\n"
- [$this event] foreach key evt {
- $evt generate $section $this
- }
- }
-
- if {[$this constructr] != ""} {
- [$this constructr] generate $section $this
- }
- if {[$this destructr] != ""} {
- [$this destructr] generate $section $this
- }
-
- [$this usermethod] foreach key method {
- if {![$method isAbstract]} {
- $method generate $section $this
- }
- }
-
- $section append "${DPCookie::regenMarker}\n\n"
- [$this genmethod] foreach key method {
- $method generate $section $this
- }
-
- if {[$this obsoletecode] != ""} {
- $section append "${DPCookie::obsoleteCode}\n\n"
- $section append "\{\$IFDEF OBSOLETE_CODE\}\n"
- $section appendSect [$this obsoletecode]
- $section append "\{\$ENDIF\}\n"
- }
- }
-
- # Do not delete this line -- regeneration end marker
-
- method DPClass::addGlobvar {this newGlobvar} {
- [$this globvarSet] append $newGlobvar
-
- }
-
- method DPClass::removeGlobvar {this oldGlobvar} {
- [$this globvarSet] removeValue $oldGlobvar
- }
-
- method DPClass::addAssocvar {this newAssocvar} {
- [$this assocvarSet] append $newAssocvar
-
- }
-
- method DPClass::removeAssocvar {this oldAssocvar} {
- [$this assocvarSet] removeValue $oldAssocvar
- }
-
- method DPClass::addUservar {this newUservar} {
- [$this uservarSet] append $newUservar
-
- }
-
- method DPClass::removeUservar {this oldUservar} {
- [$this uservarSet] removeValue $oldUservar
- }
-
- method DPClass::addProperty {this newProperty} {
- [$this propertySet] append $newProperty
-
- }
-
- method DPClass::removeProperty {this oldProperty} {
- [$this propertySet] removeValue $oldProperty
- }
-
- method DPClass::getGenmethod {this name} {
- return [[$this genmethod] set $name]
- }
-
- method DPClass::setGenmethod {this name newGenmethod} {
- [$this genmethod] set $name $newGenmethod
- }
-
- method DPClass::removeGenmethod {this name} {
- [$this genmethod] unset $name
- }
-
- method DPClass::getUsermethod {this name} {
- return [[$this usermethod] set $name]
- }
-
- method DPClass::setUsermethod {this name newUsermethod} {
- [$this usermethod] set $name $newUsermethod
- }
-
- method DPClass::removeUsermethod {this name} {
- [$this usermethod] unset $name
- }
-
- method DPClass::getEvent {this name} {
- return [[$this event] set $name]
- }
-
- method DPClass::setEvent {this name newEvent} {
- [$this event] set $name $newEvent
- }
-
- method DPClass::removeEvent {this name} {
- [$this event] unset $name
- }
-
- #---------------------------------------------------------------------------
- # File: @(#)dpenumunit.tcl /main/hindenburg/1
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class DPEnumUnit : {DPUnit} {
- constructor
- method destructor
- method generateDeclaration
- method addComponent
- method removeComponent
- attribute unitType
- attribute componentSet
- }
-
- constructor DPEnumUnit {class this} {
- set this [DPUnit::constructor $class $this]
- $this unitType "enum"
- $this componentSet [List new]
- # Start constructor user section
- # End constructor user section
- return $this
- }
-
- method DPEnumUnit::destructor {this} {
- # Start destructor user section
- # End destructor user section
- $this DPUnit::destructor
- }
-
- method DPEnumUnit::generateDeclaration {this section} {
-
- $section indent +
- $section append "[$this name] = ("
- set first 1
- [$this componentSet] foreach component {
- if {$first} {
- set first 0
- } else {
- $section append ", "
- }
- $component generate $section
- }
- $section append ");\n"
- $section indent -
- }
-
- # Do not delete this line -- regeneration end marker
-
- method DPEnumUnit::addComponent {this newComponent} {
- [$this componentSet] append $newComponent
-
- }
-
- method DPEnumUnit::removeComponent {this oldComponent} {
- [$this componentSet] removeValue $oldComponent
- }
-
- #---------------------------------------------------------------------------
- # File: @(#)dpformclas.tcl /main/hindenburg/2
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class DPFormClass : {DPClass} {
- constructor
- method destructor
- method generateForm
- attribute unitType
- attribute form
- }
-
- constructor DPFormClass {class this form} {
- set this [DPClass::constructor $class $this]
- $this unitType "formclass"
- $this form $form
- # Start constructor user section
- # End constructor user section
- return $this
- }
-
- method DPFormClass::destructor {this} {
- # Start destructor user section
- # End destructor user section
- $this DPClass::destructor
- }
-
- method DPFormClass::generateForm {this section} {
- [$this form] generateComponent $section
- }
-
- # Do not delete this line -- regeneration end marker
-
- #---------------------------------------------------------------------------
- # File: @(#)dptypedefu.tcl /main/hindenburg/2
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class DPTypeDefUnit : {DPUnit} {
- constructor
- method destructor
- method generateDeclaration
- attribute unitType
- attribute typedefType
- }
-
- constructor DPTypeDefUnit {class this typedefType} {
- set this [DPUnit::constructor $class $this]
- set this [GCObject::constructor $class $this]
- $this unitType "typedef"
- $this typedefType $typedefType
- # Start constructor user section
- # End constructor user section
- return $this
- }
-
- method DPTypeDefUnit::destructor {this} {
- # Start destructor user section
- # End destructor user section
- $this DPUnit::destructor
- }
-
- method DPTypeDefUnit::generateDeclaration {this section} {
- $section indent +
- $section append "[$this name] = "
- [$this typedefType] generate $section $this
- $section append ";\n"
- $section indent -
- }
-
- # Do not delete this line -- regeneration end marker
-
- #---------------------------------------------------------------------------
- # File: @(#)dpproperty.tcl /main/hindenburg/2
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class DPProperty : {DPFeature} {
- constructor
- method destructor
- method generate
- attribute type
- attribute read
- attribute write
- }
-
- constructor DPProperty {class this type} {
- set this [DPFeature::constructor $class $this]
- $this type $type
- # Start constructor user section
- # End constructor user section
- return $this
- }
-
- method DPProperty::destructor {this} {
- # Start destructor user section
- # End destructor user section
- $this DPFeature::destructor
- }
-
- method DPProperty::generate {this whole unit} {
-
- $whole append "property "
- $whole append "[$this name]: "
- [$this type] generate $whole $unit
- if {[$this read] != ""} {
- $whole append " read "
- $whole append [[$this read] name]
- }
- if {[$this write] != ""} {
- $whole append " write "
- $whole append [[$this write] name]
- }
- $whole append ";\n"
- }
- #endif
-
- # Do not delete this line -- regeneration end marker
-
- #---------------------------------------------------------------------------
- # File: @(#)dpfunction.tcl /main/hindenburg/3
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class DPFunction : {DPMethod} {
- constructor
- method destructor
- method generateReturnType
- attribute methodType
- attribute returnvalue
- }
-
- constructor DPFunction {class this returnvalue} {
- set this [DPMethod::constructor $class $this]
- $this methodType "function"
- $this returnvalue $returnvalue
- # Start constructor user section
- # End constructor user section
- return $this
- }
-
- method DPFunction::destructor {this} {
- # Start destructor user section
- # End destructor user section
- $this DPMethod::destructor
- }
-
- method DPFunction::generateReturnType {this whole unit} {
- $whole append ": "
- [$this returnvalue] generate $whole $unit
- }
- #endif
-
- # Do not delete this line -- regeneration end marker
-
- #---------------------------------------------------------------------------
- # File: @(#)dpform.tcl /main/hindenburg/2
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class DPForm : {DPControl} {
- constructor
- method destructor
- method getControl
- method setControl
- method removeControl
- attribute name
- attribute control
- }
-
- constructor DPForm {class this type} {
- set this [DPControl::constructor $class $this $type]
- $this control [Dictionary new]
- # Start constructor user section
- # End constructor user section
- return $this
- }
-
- method DPForm::destructor {this} {
- # Start destructor user section
- # End destructor user section
- $this DPControl::destructor
- }
-
- # Do not delete this line -- regeneration end marker
-
- method DPForm::getControl {this name} {
- return [[$this control] set $name]
- }
-
- method DPForm::setControl {this name newControl} {
- [$this control] set $name $newControl
- }
-
- method DPForm::removeControl {this name} {
- [$this control] unset $name
- }
-
- #---------------------------------------------------------------------------
- # File: @(#)dpconstruc.tcl /main/hindenburg/2
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class DPConstructor : {DPProcedure} {
- constructor
- method destructor
- attribute methodType
- attribute hasUserSection
- }
-
- constructor DPConstructor {class this} {
- set this [DPProcedure::constructor $class $this]
- $this methodType "constructor"
- $this hasUserSection 1
- # Start constructor user section
- # End constructor user section
- return $this
- }
-
- method DPConstructor::destructor {this} {
- # Start destructor user section
- # End destructor user section
- $this DPProcedure::destructor
- }
-
- # Do not delete this line -- regeneration end marker
-
- #---------------------------------------------------------------------------
- # File: @(#)dpdestruct.tcl /main/hindenburg/2
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class DPDestructor : {DPProcedure} {
- constructor
- method destructor
- attribute methodType
- attribute hasUserSection
- }
-
- constructor DPDestructor {class this} {
- set this [DPProcedure::constructor $class $this]
- $this methodType "destructor"
- $this hasUserSection 1
- # Start constructor user section
- # End constructor user section
- return $this
- }
-
- method DPDestructor::destructor {this} {
- # Start destructor user section
- # End destructor user section
- $this DPProcedure::destructor
- }
-
- # Do not delete this line -- regeneration end marker
-
-