home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World 1998 October
/
PCWorld_1998-10_cd.bin
/
software
/
prehled
/
komix
/
DATA.Z
/
javaoopl.tcl
< prev
next >
Wrap
Text File
|
1997-12-01
|
73KB
|
2,973 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 : javaoopl.tcl
# Author :
# Original date : November 1997
# Description : Classes for code generation
#
#---------------------------------------------------------------------------
# File: @(#)jvginitial.tcl /main/titanic/1
Class JVGInitializer : {Object} {
constructor
method destructor
method generate
}
constructor JVGInitializer {class this} {
# Start constructor user section
# End constructor user section
return $this
}
method JVGInitializer::destructor {this} {
# Start destructor user section
# End destructor user section
}
method JVGInitializer::generate {this sect} {
# !! Implement this function !!
}
# Do not delete this line -- regeneration end marker
if [isCommand CMInitializer] {
Class JVGInitializerD : {JVGInitializer CMInitializer} {
}
} else {
Class JVGInitializerD : {JVGInitializer OPInitializer} {
}
}
global mostDerivedOOPL ; set mostDerivedOOPL(OPInitializer) JVGInitializerD
selfPromoter OPInitializer {this} {
JVGInitializerD promote $this
}
#---------------------------------------------------------------------------
# File: @(#)jvgobject.tcl /main/titanic/2
Class JVGObject : {Object} {
constructor
method destructor
}
constructor JVGObject {class this name} {
set this [Object::constructor $class $this $name]
# Start constructor user section
# End constructor user section
return $this
}
method JVGObject::destructor {this} {
# Start destructor user section
# End destructor user section
}
proc JVGObject::generateImportStatement {ooplType unit} {
if {$ooplType != "" && [$ooplType get_obj_type] == "class_type"} {
JVGObject::generateImportStatementByClass [$ooplType ooplClass] $unit
}
}
proc JVGObject::generateImportStatementByClass {ooplClass unit} {
if {$ooplClass != "" && [$ooplClass isExternal]} {
set package [$ooplClass getPropertyValue package_stmnt]
if {$package != "" && $package != "java.lang"} {
set fullName $package.[$ooplClass getName]
$unit addSystemImport [JavaPackageName new $fullName]
}
}
}
# Do not delete this line -- regeneration end marker
#---------------------------------------------------------------------------
# File: @(#)jvgassocin.tcl /main/titanic/1
Class JVGAssocInitializer : {JVGInitializer} {
constructor
method destructor
method generate
}
constructor JVGAssocInitializer {class this} {
set this [JVGInitializer::constructor $class $this]
# Start constructor user section
# End constructor user section
return $this
}
method JVGAssocInitializer::destructor {this} {
# Start destructor user section
# End destructor user section
}
method JVGAssocInitializer::generate {this sect} {
set ident [$this getName]
$sect append "$ident = ${ident}_;\n"
}
# Do not delete this line -- regeneration end marker
if [isCommand CMAssocInitializer] {
Class JVGAssocInitializerD : {JVGAssocInitializer CMAssocInitializer} {
}
} else {
Class JVGAssocInitializerD : {JVGAssocInitializer OPAssocInitializer} {
}
}
global mostDerivedOOPL ; set mostDerivedOOPL(OPAssocInitializer) JVGAssocInitializerD
selfPromoter OPAssocInitializer {this} {
JVGAssocInitializerD promote $this
}
#---------------------------------------------------------------------------
# File: @(#)jvgattribi.tcl /main/titanic/1
Class JVGAttribInitializer : {JVGInitializer} {
constructor
method destructor
method generate
}
constructor JVGAttribInitializer {class this} {
set this [JVGInitializer::constructor $class $this]
# Start constructor user section
# End constructor user section
return $this
}
method JVGAttribInitializer::destructor {this} {
# Start destructor user section
# End destructor user section
}
method JVGAttribInitializer::generate {this sect} {
$sect append "[[$this attrib] getName] = [$this getName]_;\n"
}
# Do not delete this line -- regeneration end marker
if [isCommand CMAttribInitializer] {
Class JVGAttribInitializerD : {JVGAttribInitializer CMAttribInitializer} {
}
} else {
Class JVGAttribInitializerD : {JVGAttribInitializer OPAttribInitializer} {
}
}
global mostDerivedOOPL ; set mostDerivedOOPL(OPAttribInitializer) JVGAttribInitializerD
selfPromoter OPAttribInitializer {this} {
JVGAttribInitializerD promote $this
}
#---------------------------------------------------------------------------
# File: @(#)jvgqualini.tcl /main/titanic/1
Class JVGQualInitializer : {JVGInitializer} {
constructor
method destructor
}
constructor JVGQualInitializer {class this} {
set this [JVGInitializer::constructor $class $this]
# Start constructor user section
# End constructor user section
return $this
}
method JVGQualInitializer::destructor {this} {
# Start destructor user section
# End destructor user section
}
# Do not delete this line -- regeneration end marker
if [isCommand CMQualInitializer] {
Class JVGQualInitializerD : {JVGQualInitializer CMQualInitializer} {
}
} else {
Class JVGQualInitializerD : {JVGQualInitializer OPQualInitializer} {
}
}
global mostDerivedOOPL ; set mostDerivedOOPL(OPQualInitializer) JVGQualInitializerD
selfPromoter OPQualInitializer {this} {
JVGQualInitializerD promote $this
}
#---------------------------------------------------------------------------
# File: @(#)jvgsupercl.tcl /main/titanic/1
Class JVGSuperClassInitializer : {JVGInitializer} {
constructor
method destructor
}
constructor JVGSuperClassInitializer {class this} {
set this [JVGInitializer::constructor $class $this]
# Start constructor user section
# End constructor user section
return $this
}
method JVGSuperClassInitializer::destructor {this} {
# Start destructor user section
# End destructor user section
}
# Do not delete this line -- regeneration end marker
if [isCommand CMSuperClassInitializer] {
Class JVGSuperClassInitializerD : {JVGSuperClassInitializer CMSuperClassInitializer} {
}
} else {
Class JVGSuperClassInitializerD : {JVGSuperClassInitializer OPSuperClassInitializer} {
}
}
global mostDerivedOOPL ; set mostDerivedOOPL(OPSuperClassInitializer) JVGSuperClassInitializerD
selfPromoter OPSuperClassInitializer {this} {
JVGSuperClassInitializerD promote $this
}
#---------------------------------------------------------------------------
# File: @(#)jvgclass.tcl /main/titanic/12
Class JVGClass : {JVGObject} {
constructor
method destructor
method check
method checkClass
method checkInterface
method generate
method generateClass
method generateInterface
method generateAccess
method generateComment
method generateContainer
method generateImportStatements
method generateModifier
method generatePackages
method getModifier
method isExternal
method isInterface
method setUnit
attribute isMaster
attribute unit
attribute container
}
constructor JVGClass {class this name} {
set this [JVGObject::constructor $class $this $name]
# Start constructor user section
# End constructor user section
return $this
}
method JVGClass::destructor {this} {
# Start destructor user section
# End destructor user section
}
method JVGClass::check {this} {
if [$this isInterface] {
return [$this checkInterface]
}
return [$this checkClass]
}
method JVGClass::checkClass {this} {
#
# Check if class has only one base class
#
set firstBase ""
foreach genNode [$this genNodeSet] {
set super [$genNode superClass]
set superName [$super getName]
if {![$super isInterface]} {
if {$firstBase != ""} {
m4_error $E_NOMULTINH [$this getName] $superName $firstBase
} else {
set firstBase $superName
}
}
}
#
# Check all features
#
foreach feature [$this featureSet] {
$feature check
}
}
method JVGClass::checkInterface {this} {
#
# Interface should not be derived from Class
#
foreach genNode [$this genNodeSet] {
set super [$genNode superClass]
set superName [$super getName]
if {![$super isInterface]} {
m4_error $E_INTFROMCLASS [$this getName] $superName
}
}
#
# Interface should not be final
#
if {[$this getModifier] == "final"} {
m4_warning $W_INTNOTFINAL [$this getName]
}
#
# Interface should not have a constructor
#
foreach method [$this operationSet] {
if {[$method isClassFeature] && [$method getName] == "create"} {
m4_warning $W_INTNOCONSTR [$this getName]
} else {
$method check
}
}
#
# Interface should not have association attributes
#
foreach assocAttr [$this genAssocAttrSet] {
set item [[$assocAttr smConnector] getItem]
if [$item isNil] {
set itemName ""
} else {
set itemName [$item name]
}
m4_warning $W_INTASSOCATTR [$assocAttr getName] $itemName [$this getName]
}
#
# Check data attributes
#
foreach dataAttr [$this dataAttrSet] {
$dataAttr check
}
}
method JVGClass::generate {this model} {
if {[$this isExternal] || [$this container] != ""} {
return
}
$this check
$this setUnit $model
$this generateImportStatements
if [$this isInterface] {
$this generateInterface
} else {
$this generateClass
}
}
method JVGClass::generateClass {this} {
$this container [JavaClass new $this]
$this generateContainer
$this generatePackages
$this generateComment
$this generateAccess
$this generateModifier
set javaContainer [$this container]
foreach genNode [$this genNodeSet] {
set super [$genNode superClass]
set superName [$super getName]
if [$super isInterface] {
$javaContainer addInterface $superName
} else {
$javaContainer superClass $superName
}
}
if {[$this constructor] != ""} {
[$this constructor] generate
}
foreach dataAttr [$this dataAttrSet] {
$dataAttr generate
}
foreach method [$this operationSet] {
$method generate
}
foreach assocAttr [$this genAssocAttrSet] {
$assocAttr generate
}
}
method JVGClass::generateInterface {this} {
$this container [JavaInterface new $this]
$this generateContainer
$this generatePackages
$this generateComment
$this generateAccess
$this generateModifier
foreach genNode [$this genNodeSet] {
set super [$genNode superClass]
set superName [$super getName]
if [$super isInterface] {
[$this container] addInterface $superName
}
}
foreach dataAttr [$this dataAttrSet] {
$dataAttr generate
}
foreach method [$this operationSet] {
if {[$method isClassFeature] && [$method getName] == "create"} {
# m4_warning $W_INTNOCONSTR [$this getName]
} else {
$method generate
}
}
}
method JVGClass::generateAccess {this} {
set access [string tolower [$this getPropertyValue class_access]]
if {$access != "none"} {
if [$this isMaster] {
if {$access == ""} {
set access "public"
}
} else {
if {$access == "public"} {
m4_warning $W_NOTPUBLIC [$this getName] [[$this unit] name]
set access ""
}
}
if {$access != ""} {
[$this container] access [JavaAccess new $access]
}
}
}
method JVGClass::generateComment {this} {
set text [$this getPropertyValue freeText]
if {$text == ""} {
return
}
set type [$this getPropertyValue comment_type]
switch $type {
Block {[$this container] comment [JavaBlockComment new $text]}
Document {[$this container] comment [JavaDocComment new $text]}
default {[$this container] comment [JavaLineComment new $text]}
}
}
method JVGClass::generateContainer {this} {
set unit [$this unit]
$unit addContainer [$this container]
if {[$this getName] == [$unit name]} {
$this isMaster 1
$unit masterContainer [$this container]
set packageStatement [$this getPropertyValue package_stmnt]
if {$packageStatement != ""} {
$unit packageStatement [JavaPackageName new "$packageStatement"]
}
} else {
$this isMaster 0
}
}
method JVGClass::generateImportStatements {this} {
foreach genNode [$this genNodeSet] {
set super [$genNode superClass]
JVGObject::generateImportStatementByClass $super [$this unit]
}
}
method JVGClass::generateModifier {this} {
set modifier [$this getModifier]
if {$modifier != ""} {
if {[$this isInterface] && $modifier == "final"} {
# m4_warning $W_INTNOTFINAL [$this getName]
} else {
[$this container] modifier [JavaModifier new $modifier]
}
}
}
method JVGClass::generatePackages {this} {
set unit [$this unit]
foreach importPackage [$this getPropertyValue import_package] {
$unit addImportPackage [JavaPackageName new $importPackage]
}
foreach importType [$this getPropertyValue import_type] {
$unit addImportType [JavaPackageName new $importType]
}
foreach importOnDemand [$this getPropertyValue import_ondemand] {
$unit addImportOnDemand [JavaPackageName new $importOnDemand]
}
}
method JVGClass::getModifier {this} {
return [string tolower [$this getPropertyValue class_modifier]]
}
method JVGClass::isExternal {this} {
if [$this OPClass::isExternal] {
return 1
}
if [string match External* [$this getPropertyValue class_interface]] {
return 1
}
return 0
}
method JVGClass::isInterface {this} {
if [string match *Interface [$this getPropertyValue class_interface]] {
return 1
}
return 0
}
method JVGClass::setUnit {this model} {
set unitName [$this getPropertyValue "source_file"]
if {$unitName == ""} {
set unitName [$this getName]
}
$this unit [$model getCompilationUnit $unitName]
}
# Do not delete this line -- regeneration end marker
if [isCommand CMClass] {
Class JVGClassD : {JVGClass CMClass} {
}
} else {
Class JVGClassD : {JVGClass OPClass} {
}
}
global mostDerivedOOPL ; set mostDerivedOOPL(OPClass) JVGClassD
selfPromoter OPClass {this} {
JVGClassD promote $this
}
#---------------------------------------------------------------------------
# File: @(#)jvgfeature.tcl /main/titanic/7
Class JVGFeature : {JVGObject} {
constructor
method destructor
method check
method generate
method generateImportStatements
method getComment
method getMethodAccess
method getTypeName
method isFinal
method isNative
method isSynchronized
method isThreadsafe
method isTransient
method isVolatile
}
constructor JVGFeature {class this name} {
set this [JVGObject::constructor $class $this $name]
# Start constructor user section
# End constructor user section
return $this
}
method JVGFeature::destructor {this} {
# Start destructor user section
# End destructor user section
}
method JVGFeature::check {this} {
# !! Implement this function !!
}
method JVGFeature::generate {this} {
# !! Implement this function !!
}
method JVGFeature::generateImportStatements {this} {
JVGObject::generateImportStatement [$this ooplType] [[$this ooplClass] unit]
}
method JVGFeature::getComment {this} {
set text [$this getPropertyValue freeText]
if {$text == ""} {
return ""
}
set type [$this getPropertyValue comment_type]
switch $type {
Block {return [JavaBlockComment new $text]}
Document {return [JavaDocComment new $text]}
default {return [JavaLineComment new $text]}
}
}
method JVGFeature::getMethodAccess {this} {
return [string tolower [$this getPropertyValue method_access]]
}
method JVGFeature::getTypeName {this} {
if {[$this ooplType] == ""} {
return ""
}
return [[$this ooplType] getName]
}
method JVGFeature::isFinal {this} {
if {[$this getPropertyValue is_final] == "1"} {
return "1"
}
return "0"
}
method JVGFeature::isNative {this} {
if {[$this getPropertyValue is_native] == "1"} {
return "1"
}
return "0"
}
method JVGFeature::isSynchronized {this} {
if {[$this getPropertyValue is_synchronized] == "1"} {
return "1"
}
return "0"
}
method JVGFeature::isThreadsafe {this} {
if {[$this getPropertyValue is_threadsafe] == "1"} {
return "1"
}
return "0"
}
method JVGFeature::isTransient {this} {
if {[$this getPropertyValue is_transient] == "1"} {
return "1"
}
return "0"
}
method JVGFeature::isVolatile {this} {
if {[$this getPropertyValue is_volatile] == "1"} {
return "1"
}
return "0"
}
# Do not delete this line -- regeneration end marker
if [isCommand CMFeature] {
Class JVGFeatureD : {JVGFeature CMFeature} {
}
} else {
Class JVGFeatureD : {JVGFeature OPFeature} {
}
}
global mostDerivedOOPL ; set mostDerivedOOPL(OPFeature) JVGFeatureD
selfPromoter OPFeature {this} {
JVGFeatureD promote $this
}
#---------------------------------------------------------------------------
# File: @(#)jvgparamet.tcl /main/titanic/2
Class JVGParameter : {JVGObject} {
constructor
method destructor
method generateImportStatements
}
constructor JVGParameter {class this name} {
set this [JVGObject::constructor $class $this $name]
# Start constructor user section
# End constructor user section
return $this
}
method JVGParameter::destructor {this} {
# Start destructor user section
# End destructor user section
}
method JVGParameter::generateImportStatements {this unit} {
JVGObject::generateImportStatement [$this ooplType] $unit
}
# Do not delete this line -- regeneration end marker
if [isCommand CMParameter] {
Class JVGParameterD : {JVGParameter CMParameter} {
}
} else {
Class JVGParameterD : {JVGParameter OPParameter} {
}
}
global mostDerivedOOPL ; set mostDerivedOOPL(OPParameter) JVGParameterD
selfPromoter OPParameter {this} {
JVGParameterD promote $this
}
#---------------------------------------------------------------------------
# File: @(#)jvgtype.tcl /main/titanic/4
Class JVGType : {JVGObject} {
constructor
method destructor
}
constructor JVGType {class this name} {
set this [JVGObject::constructor $class $this $name]
# Start constructor user section
# End constructor user section
return $this
}
method JVGType::destructor {this} {
# Start destructor user section
# End destructor user section
}
# Do not delete this line -- regeneration end marker
if [isCommand CMType] {
Class JVGTypeD : {JVGType CMType} {
}
} else {
Class JVGTypeD : {JVGType OPType} {
}
}
global mostDerivedOOPL ; set mostDerivedOOPL(OPType) JVGTypeD
selfPromoter OPType {this} {
JVGTypeD promote $this
}
#---------------------------------------------------------------------------
# File: @(#)jvgclassen.tcl /main/titanic/4
Class JVGClassEnum : {JVGClass} {
constructor
method destructor
method check
method generate
}
constructor JVGClassEnum {class this name} {
set this [JVGClass::constructor $class $this $name]
# Start constructor user section
# End constructor user section
return $this
}
method JVGClassEnum::destructor {this} {
# Start destructor user section
# End destructor user section
}
method JVGClassEnum::check {this} {
# !! Implement this function !!
}
method JVGClassEnum::generate {this model} {
if {[$this isExternal] || [$this container] != ""} {
return
}
$this setUnit $model
$this generateImportStatements
$this container [JavaEnumClass new $this]
$this generateContainer
$this generatePackages
$this generateComment
$this generateAccess
$this generateModifier
foreach dataAttr [$this dataAttrSet] {
$dataAttr generateEnumVariable
}
}
# Do not delete this line -- regeneration end marker
if [isCommand CMClassEnum] {
Class JVGClassEnumD : {JVGClassEnum CMClassEnum} {
}
} else {
Class JVGClassEnumD : {JVGClassEnum OPClassEnum} {
}
}
global mostDerivedOOPL ; set mostDerivedOOPL(OPClassEnum) JVGClassEnumD
selfPromoter OPClassEnum {this} {
JVGClassEnumD promote $this
}
#---------------------------------------------------------------------------
# File: @(#)jvgclassge.tcl /main/titanic/3
Class JVGClassGenericTypeDef : {JVGClass} {
constructor
method destructor
method check
method generate
}
constructor JVGClassGenericTypeDef {class this name} {
set this [JVGClass::constructor $class $this $name]
# Start constructor user section
# End constructor user section
return $this
}
method JVGClassGenericTypeDef::destructor {this} {
# Start destructor user section
# End destructor user section
}
method JVGClassGenericTypeDef::check {this} {
# !! Implement this function !!
}
method JVGClassGenericTypeDef::generate {this model} {
$this JVGClass::generate $model
}
# Do not delete this line -- regeneration end marker
if [isCommand CMClassGenericTypeDef] {
Class JVGClassGenericTypeDefD : {JVGClassGenericTypeDef CMClassGenericTypeDef} {
}
} else {
Class JVGClassGenericTypeDefD : {JVGClassGenericTypeDef OPClassGenericTypeDef} {
}
}
global mostDerivedOOPL ; set mostDerivedOOPL(OPClassGenericTypeDef) JVGClassGenericTypeDefD
selfPromoter OPClassGenericTypeDef {this} {
JVGClassGenericTypeDefD promote $this
}
#---------------------------------------------------------------------------
# File: @(#)jvgclasstd.tcl /main/titanic/3
Class JVGClassTDef : {JVGClass} {
constructor
method destructor
method check
method generate
}
constructor JVGClassTDef {class this name} {
set this [JVGClass::constructor $class $this $name]
# Start constructor user section
# End constructor user section
return $this
}
method JVGClassTDef::destructor {this} {
# Start destructor user section
# End destructor user section
}
method JVGClassTDef::check {this} {
# !! Implement this function !!
}
method JVGClassTDef::generate {this model} {
$this JVGClass::generate $model
}
# Do not delete this line -- regeneration end marker
if [isCommand CMClassTDef] {
Class JVGClassTDefD : {JVGClassTDef CMClassTDef} {
}
} else {
Class JVGClassTDefD : {JVGClassTDef OPClassTDef} {
}
}
global mostDerivedOOPL ; set mostDerivedOOPL(OPClassTDef) JVGClassTDefD
selfPromoter OPClassTDef {this} {
JVGClassTDefD promote $this
}
#---------------------------------------------------------------------------
# File: @(#)jvgdatabas.tcl /main/titanic/3
Class JVGDatabaseClass : {JVGClass} {
constructor
method destructor
method check
method generate
}
constructor JVGDatabaseClass {class this name} {
set this [JVGClass::constructor $class $this $name]
# Start constructor user section
# End constructor user section
return $this
}
method JVGDatabaseClass::destructor {this} {
# Start destructor user section
# End destructor user section
}
method JVGDatabaseClass::check {this} {
m4_warning $W_PERSISTENT [$this getName]
}
method JVGDatabaseClass::generate {this model} {
$this check
}
# Do not delete this line -- regeneration end marker
if [isCommand CMDatabaseClass] {
Class JVGDatabaseClassD : {JVGDatabaseClass CMDatabaseClass} {
}
} else {
Class JVGDatabaseClassD : {JVGDatabaseClass OPDatabaseClass} {
}
}
global mostDerivedOOPL ; set mostDerivedOOPL(OPDatabaseClass) JVGDatabaseClassD
selfPromoter OPDatabaseClass {this} {
JVGDatabaseClassD promote $this
}
#---------------------------------------------------------------------------
# File: @(#)jvglinkcla.tcl /main/titanic/3
Class JVGLinkClass : {JVGClass} {
constructor
method destructor
method check
method generate
}
constructor JVGLinkClass {class this name} {
set this [JVGClass::constructor $class $this $name]
# Start constructor user section
# End constructor user section
return $this
}
method JVGLinkClass::destructor {this} {
# Start destructor user section
# End destructor user section
}
method JVGLinkClass::check {this} {
# !! Implement this function !!
}
method JVGLinkClass::generate {this model} {
$this JVGClass::generate $model
}
# Do not delete this line -- regeneration end marker
if [isCommand CMLinkClass] {
Class JVGLinkClassD : {JVGLinkClass CMLinkClass} {
}
} else {
Class JVGLinkClassD : {JVGLinkClass OPLinkClass} {
}
}
global mostDerivedOOPL ; set mostDerivedOOPL(OPLinkClass) JVGLinkClassD
selfPromoter OPLinkClass {this} {
JVGLinkClassD promote $this
}
#---------------------------------------------------------------------------
# File: @(#)jvgattribu.tcl /main/titanic/7
Class JVGAttribute : {JVGFeature} {
constructor
method destructor
method generate
method getAccessorAccess
method getAttributeAccess
}
constructor JVGAttribute {class this name} {
set this [JVGFeature::constructor $class $this $name]
# Start constructor user section
# End constructor user section
return $this
}
method JVGAttribute::destructor {this} {
# Start destructor user section
# End destructor user section
}
method JVGAttribute::generate {this} {
# !! Implement this function !!
}
method JVGAttribute::getAccessorAccess {this mode} {
set access [string tolower [$this getPropertyValue attrib_access]]
if {$access == ""} {
return "public"
}
set rwAccessList [split $access -]
if {[llength $rwAccessList] == 2} {
if {$mode == "r"} {
return [lindex $rwAccessList 0]
}
return [lindex $rwAccessList 1]
}
return $access
}
method JVGAttribute::getAttributeAccess {this} {
return [string tolower [$this getPropertyValue attrib_visibility]]
}
# Do not delete this line -- regeneration end marker
if [isCommand CMAttribute] {
Class JVGAttributeD : {JVGAttribute CMAttribute} {
}
} else {
Class JVGAttributeD : {JVGAttribute OPAttribute} {
}
}
global mostDerivedOOPL ; set mostDerivedOOPL(OPAttribute) JVGAttributeD
selfPromoter OPAttribute {this} {
JVGAttributeD promote $this
}
#---------------------------------------------------------------------------
# File: @(#)jvgconstru.tcl /main/titanic/7
Class JVGConstructor : {JVGFeature} {
constructor
method destructor
method generate
}
constructor JVGConstructor {class this name} {
set this [JVGFeature::constructor $class $this $name]
# Start constructor user section
# End constructor user section
return $this
}
method JVGConstructor::destructor {this} {
# Start destructor user section
# End destructor user section
}
method JVGConstructor::generate {this} {
set class [$this ooplClass]
if [$class isInterface] {
return
}
set container [$class container]
set constructor [JavaConstructor new [$class getName]]
$container defaultConstructor $constructor
$container addConstructor $constructor
foreach param [$class creationParamSet] {
set paramType [JavaType new [[$param ooplType] getName]]
set javaParam [JavaParameter new [$param getName]_ $paramType]
$constructor addParameter $javaParam
}
set genBody [TextSection new]
$constructor generatorBody $genBody
set superInitList ""
foreach scInitializer [$this superClassInitializerSet] {
foreach param [$scInitializer parameterSet] {
lappend superInitList "[$param getName]_"
}
}
if {$superInitList != ""} {
$genBody append "super([join $superInitList ", "]);\n"
}
foreach initializer [$this initializerSet] {
$initializer generate $genBody
}
foreach assoc [$class genAssocAttrSet] {
set var [$assoc getAssocVariable]
if {![$assoc isClassFeature]} {
if [$assoc isQualified] {
$genBody append "$var = new Hashtable();\n"
} elseif {[$assoc getMultiplicity] == "many"} {
if {[$assoc isOrdered]} {
$genBody append "$var = new Queue();\n"
} else {
$genBody append "$var = new Vector();\n"
}
}
}
if [$assoc isReverseLinkAttr] {
set opposite [$assoc opposite]
if {$opposite != ""} {
$genBody append [$opposite extendAssociation $var]
}
}
}
set access [$this getMethodAccess]
if {$access == ""} {
set access "public"
}
$constructor access [JavaAccess new $access]
}
# Do not delete this line -- regeneration end marker
if [isCommand CMConstructor] {
Class JVGConstructorD : {JVGConstructor CMConstructor} {
}
} else {
Class JVGConstructorD : {JVGConstructor OPConstructor} {
}
}
global mostDerivedOOPL ; set mostDerivedOOPL(OPConstructor) JVGConstructorD
selfPromoter OPConstructor {this} {
JVGConstructorD promote $this
}
#---------------------------------------------------------------------------
# File: @(#)jvgoperati.tcl /main/titanic/11
Class JVGOperation : {JVGFeature} {
constructor
method destructor
method check
method checkClassMethod
method checkInterfaceMethod
method checkStaticInitializer
method checkUserConstructor
method generate
method generateClassMethod
method generateExceptions
method generateImportStatements
method generateInterfaceMethod
method generateParameters
method generateStaticInitializer
method generateUserConstructor
method injectCode
}
constructor JVGOperation {class this name} {
set this [JVGFeature::constructor $class $this $name]
# Start constructor user section
# End constructor user section
return $this
}
method JVGOperation::destructor {this} {
# Start destructor user section
# End destructor user section
}
method JVGOperation::check {this} {
if {[$this getPropertyValue is_static] != ""} {
m4_warning $W_OLDPROPERTY is_static
}
if {[$this getMethodAccess] == "private protected"} {
m4_warning $W_PRIVPROT method [$this getName] [[$this ooplClass] getName]
}
if {[$this isClassFeature] && [$this getName] == "create"} {
return [$this checkUserConstructor]
}
if {[$this getName] == "static"} {
return [$this checkStaticInitializer]
}
if [[$this ooplClass] isInterface] {
return [$this checkInterfaceMethod]
}
return [$this checkClassMethod]
}
method JVGOperation::checkClassMethod {this} {
if [$this isAbstract] {
set class [$this ooplClass]
set className [$class getName]
if {[$class getModifier] != "abstract"} {
m4_warning $W_ABSTRACTMETH $className [$this getName]
}
set access [$this getMethodAccess]
if {$access == "private" || $access == "private protected"} {
m4_warning $W_ABSPRIVMETH $access [$this getName] $className
}
}
}
method JVGOperation::checkInterfaceMethod {this} {
set access [$this getMethodAccess]
set className [[$this ooplClass] getName]
if {$access == "private" || $access == "protected" ||
$access == "private protected"} {
m4_warning $W_INVINTDECL $access [$this getName] $className
}
if [$this isNative] {
m4_warning $W_INVINTDECL native [$this getName] $className
}
if [$this isClassFeature] {
m4_warning $W_INVINTDECL static [$this getName] $className
}
if [$this isSynchronized] {
m4_warning $W_INVINTDECL synchronized [$this getName] $className
}
if [$this isFinal] {
m4_warning $W_INVINTDECL final [$this getName] $className
}
}
method JVGOperation::checkStaticInitializer {this} {
}
method JVGOperation::checkUserConstructor {this} {
}
method JVGOperation::generate {this} {
$this generateImportStatements
set name [$this getName]
if {[$this isClassFeature] && $name == "create"} {
return [$this generateUserConstructor]
}
if {$name == "static"} {
return [$this generateStaticInitializer]
}
if [[$this ooplClass] isInterface] {
return [$this generateInterfaceMethod]
}
return [$this generateClassMethod]
}
method JVGOperation::generateClassMethod {this} {
set class [$this ooplClass]
set container [$class container]
set method [JavaUserMethod new [$this getName]]
$container addMethod $method
$method comment [$this getComment]
if {[$this getTypeName] == ""} {
$method type [JavaType new "void"]
} else {
$method type [JavaType new [$this getTypeName]]
}
set access [$this getMethodAccess]
if {[$this isAbstract] &&
($access == "private" || $access == "private protected")} {
set access "none"
}
if {$access != "none"} {
if {$access == ""} {
set access "public"
}
$method access [JavaAccess new $access]
}
if [$this isAbstract] {
$method addModifier [JavaModifier new "abstract"]
$method hasBody 0
} else {
if [$this isClassFeature] {
$method addModifier [JavaModifier new "static"]
}
if [$this isFinal] {
$method addModifier [JavaModifier new "final"]
}
}
if [$this isNative] {
$method addModifier [JavaModifier new "native"]
$method hasBody 0
}
if [$this isSynchronized] {
$method addModifier [JavaModifier new "synchronized"]
}
$this injectCode $method
$this generateParameters $method
$this generateExceptions $method
}
method JVGOperation::generateExceptions {this method} {
foreach throwException [$this getPropertyValue method_exceptions] {
$method addThrow [JavaException new $throwException]
}
}
method JVGOperation::generateImportStatements {this} {
$this JVGFeature::generateImportStatements
foreach param [$this parameterSet] {
$param generateImportStatements [[$this ooplClass] unit]
}
}
method JVGOperation::generateInterfaceMethod {this} {
set class [$this ooplClass]
set container [$class container]
set method [JavaUserMethod new [$this getName]]
$container addMethod $method
$method hasBody 0
$method comment [$this getComment]
if {[$this getTypeName] == ""} {
$method type [JavaType new "void"]
} else {
$method type [JavaType new [$this getTypeName]]
}
set access [$this getMethodAccess]
if {$access != "none"} {
set access "public"
$method access [JavaAccess new $access]
}
if [$this isAbstract] {
$method addModifier [JavaModifier new "abstract"]
$method hasBody 0
}
$this generateParameters $method
$this generateExceptions $method
}
method JVGOperation::generateParameters {this method} {
foreach param [$this parameterSet] {
set paramType [JavaType new [[$param ooplType] getName]]
set javaParam [JavaParameter new [$param getName] $paramType]
$method addParameter $javaParam
}
}
method JVGOperation::generateStaticInitializer {this} {
set container [[$this ooplClass] container]
set initializer [JavaStaticInitializer new "static"]
$container addMethod $initializer
$initializer comment [$this getComment]
$this injectCode $initializer
}
method JVGOperation::generateUserConstructor {this} {
set class [$this ooplClass]
set container [$class container]
set constructor [JavaUserConstructor new [$class getName]]
$container addUserConstructor $constructor
$container addConstructor $constructor
$constructor comment [$this getComment]
foreach param [$this parameterSet] {
set paramType [JavaType new [[$param ooplType] getName]]
set javaParam [JavaParameter new [$param getName] $paramType]
$constructor addParameter $javaParam
}
foreach throwException [$this getPropertyValue method_exceptions] {
$constructor addThrow [JavaException new $throwException]
}
set access [$this getMethodAccess]
if {$access == "" || $access == "none"} {
set access "public"
}
$constructor access [JavaAccess new $access]
$this injectCode $constructor
}
method JVGOperation::injectCode {this method} {
if {[m4_var get M4_code_injection] == "true"} {
set code [$this getPropertyValue code_injection_body]
if {$code != ""} {
set codeSection [TextSection new]
$codeSection append $code
$method userBody $codeSection
}
}
}
# Do not delete this line -- regeneration end marker
if [isCommand CMOperation] {
Class JVGOperationD : {JVGOperation CMOperation} {
}
} else {
Class JVGOperationD : {JVGOperation OPOperation} {
}
}
global mostDerivedOOPL ; set mostDerivedOOPL(OPOperation) JVGOperationD
selfPromoter OPOperation {this} {
JVGOperationD promote $this
}
#---------------------------------------------------------------------------
# File: @(#)jvgctorpar.tcl /main/titanic/2
Class JVGCtorParameter : {JVGParameter} {
constructor
method destructor
}
constructor JVGCtorParameter {class this name} {
set this [JVGParameter::constructor $class $this $name]
# Start constructor user section
# End constructor user section
return $this
}
method JVGCtorParameter::destructor {this} {
# Start destructor user section
# End destructor user section
}
# Do not delete this line -- regeneration end marker
if [isCommand CMCtorParameter] {
Class JVGCtorParameterD : {JVGCtorParameter CMCtorParameter} {
}
} else {
Class JVGCtorParameterD : {JVGCtorParameter OPCtorParameter} {
}
}
global mostDerivedOOPL ; set mostDerivedOOPL(OPCtorParameter) JVGCtorParameterD
selfPromoter OPCtorParameter {this} {
JVGCtorParameterD promote $this
}
#---------------------------------------------------------------------------
# File: @(#)jvgoperpar.tcl /main/titanic/2
Class JVGOperParameter : {JVGParameter} {
constructor
method destructor
}
constructor JVGOperParameter {class this name} {
set this [JVGParameter::constructor $class $this $name]
# Start constructor user section
# End constructor user section
return $this
}
method JVGOperParameter::destructor {this} {
# Start destructor user section
# End destructor user section
}
# Do not delete this line -- regeneration end marker
if [isCommand CMOperParameter] {
Class JVGOperParameterD : {JVGOperParameter CMOperParameter} {
}
} else {
Class JVGOperParameterD : {JVGOperParameter OPOperParameter} {
}
}
global mostDerivedOOPL ; set mostDerivedOOPL(OPOperParameter) JVGOperParameterD
selfPromoter OPOperParameter {this} {
JVGOperParameterD promote $this
}
#---------------------------------------------------------------------------
# File: @(#)jvgbasetyp.tcl /main/titanic/3
Class JVGBaseType : {JVGType} {
constructor
method destructor
method getName
}
constructor JVGBaseType {class this name} {
set this [JVGType::constructor $class $this $name]
# Start constructor user section
# End constructor user section
return $this
}
method JVGBaseType::destructor {this} {
# Start destructor user section
# End destructor user section
}
method JVGBaseType::getName {this} {
set name [$this getType3GL]
if {$name != ""} {
return $name
}
return [$this OPType::getName]
}
# Do not delete this line -- regeneration end marker
if [isCommand CMBaseType] {
Class JVGBaseTypeD : {JVGBaseType CMBaseType} {
}
} else {
Class JVGBaseTypeD : {JVGBaseType OPBaseType} {
}
}
global mostDerivedOOPL ; set mostDerivedOOPL(OPBaseType) JVGBaseTypeD
selfPromoter OPBaseType {this} {
JVGBaseTypeD promote $this
}
#---------------------------------------------------------------------------
# File: @(#)jvgdblinkc.tcl /main/titanic/3
Class JVGDBLinkClass : {JVGLinkClass} {
constructor
method destructor
method check
method generate
}
constructor JVGDBLinkClass {class this name} {
set this [JVGLinkClass::constructor $class $this $name]
# Start constructor user section
# End constructor user section
return $this
}
method JVGDBLinkClass::destructor {this} {
# Start destructor user section
# End destructor user section
}
method JVGDBLinkClass::check {this} {
m4_warning $W_PERSISTENT [$this getName]
}
method JVGDBLinkClass::generate {this model} {
$this check
}
# Do not delete this line -- regeneration end marker
if [isCommand CMDBLinkClass] {
Class JVGDBLinkClassD : {JVGDBLinkClass CMDBLinkClass} {
}
} else {
Class JVGDBLinkClassD : {JVGDBLinkClass OPDBLinkClass} {
}
}
global mostDerivedOOPL ; set mostDerivedOOPL(OPDBLinkClass) JVGDBLinkClassD
selfPromoter OPDBLinkClass {this} {
JVGDBLinkClassD promote $this
}
#---------------------------------------------------------------------------
# File: @(#)jvgdataatt.tcl /main/titanic/10
Class JVGDataAttr : {JVGAttribute} {
constructor
method destructor
method check
method checkClassVariable
method checkInterfaceVariable
method generate
method generateClassVariable
method generateEnumVariable
method generateInterfaceVariable
method getVariableInitializer
}
constructor JVGDataAttr {class this name} {
set this [JVGAttribute::constructor $class $this $name]
# Start constructor user section
# End constructor user section
return $this
}
method JVGDataAttr::destructor {this} {
# Start destructor user section
# End destructor user section
}
method JVGDataAttr::check {this} {
if {[$this getPropertyValue is_static] != ""} {
m4_warning $W_OLDPROPERTY is_static
}
if {[$this getPropertyValue default_value] != ""} {
m4_warning $W_OLDPROPERTY default_value
}
if {[$this getAttributeAccess] == "private protected"} {
m4_warning $W_PRIVPROT attribute [$this getName] [[$this ooplClass] getName]
}
if [[$this ooplClass] isInterface] {
return [$this checkInterfaceVariable]
}
return [$this checkClassVariable]
}
method JVGDataAttr::checkClassVariable {this} {
set class [$this ooplClass]
if [$this isTransient] {
if {[$this isClassFeature] || [$this isFinal]} {
m4_warning $W_TRANSIENTVAR [$this getName] [$class getName]
}
}
if {[$this isFinal] && [$this getPropertyValue initial_value] == ""} {
m4_warning $W_FINALVAR [$this getName] [$class getName]
}
if {[$this isFinal] && [$this isVolatile]} {
m4_warning $W_VOLFINVAR [$this getName] [$class getName]
}
}
method JVGDataAttr::checkInterfaceVariable {this} {
if {[$this getPropertyValue initial_value] == ""} {
m4_warning $W_INTVARNOASSGN [$this getName]
}
if [$this isVolatile] {
m4_warning $W_VOLINTVAR [$this getName] [[$this ooplClass] getName]
}
}
method JVGDataAttr::generate {this} {
$this generateImportStatements
if [[$this ooplClass] isInterface] {
return [$this generateInterfaceVariable]
}
return [$this generateClassVariable]
}
method JVGDataAttr::generateClassVariable {this} {
set class [$this ooplClass]
set container [$class container]
set variable [JavaVariable new [$this getName]]
$container addVariable $variable
$variable type [JavaType new [$this getTypeName]]
$variable comment [$this getComment]
$variable initializer [$this getVariableInitializer]
set access [$this getAttributeAccess]
if {$access != "none"} {
if {$access == ""} {
set access "private"
}
$variable access [JavaAccess new $access]
}
if [$this isClassFeature] {
$variable addModifier [JavaModifier new "static"]
}
if [$this isFinal] {
$variable addModifier [JavaModifier new "final"]
}
if [$this isThreadsafe] {
$variable addModifier [JavaModifier new "threadsafe"]
}
if [$this isTransient] {
$variable addModifier [JavaModifier new "transient"]
}
if [$this isVolatile] {
$variable addModifier [JavaModifier new "volatile"]
}
#
# Generate accessor methods
#
set access [$this getAccessorAccess "r"]
if {$access != "none"} {
set ident [$this getName]
set genBody [TextSection new]
set accessor [JavaAccMethod new "get[cap $ident]"]
if [$this isClassFeature] {
$accessor addModifier [JavaModifier new "static"]
}
$accessor type [JavaType new [$this getTypeName]]
$container addAttributeAccessor $accessor
$accessor access [JavaAccess new $access]
$accessor generatorBody $genBody
$genBody append "return $ident;\n"
}
set access [$this getAccessorAccess "w"]
if {![$this isFinal] && $access != "none"} {
set ident [$this getName]
set paramId "${ident}_"
set genBody [TextSection new]
set accessor [JavaAccMethod new "set[cap $ident]"]
set type [JavaType new [$this getTypeName]]
set parameter [JavaParameter new $paramId $type]
if [$this isClassFeature] {
$accessor addModifier [JavaModifier new "static"]
}
$container addAttributeAccessor $accessor
$accessor type [JavaType new "void"]
$accessor addParameter $parameter
$accessor access [JavaAccess new $access]
$accessor generatorBody $genBody
$genBody append "$ident = $paramId;\n"
}
}
method JVGDataAttr::generateEnumVariable {this} {
set variable [JavaVariable new [$this getName]]
[[$this ooplClass] container] addVariable $variable
$variable type [JavaType new "int"]
$variable initializer [$this getVariableInitializer]
$variable addModifier [JavaModifier new "static"]
$variable addModifier [JavaModifier new "final"]
set access [$this getAttributeAccess]
if {$access != "none"} {
if {$access == ""} {
set access "public"
}
$variable access [JavaAccess new $access]
}
}
method JVGDataAttr::generateInterfaceVariable {this} {
set class [$this ooplClass]
set container [$class container]
set variable [JavaVariable new [$this getName]]
$container addVariable $variable
$variable type [JavaType new [$this getTypeName]]
$variable comment [$this getComment]
$variable access [JavaAccess new "public"]
$variable initializer [$this getVariableInitializer]
if [$this isClassFeature] {
$variable addModifier [JavaModifier new "static"]
}
if [$this isFinal] {
$variable addModifier [JavaModifier new "final"]
}
}
method JVGDataAttr::getVariableInitializer {this} {
if {[set initVal [$this getPropertyValue initial_value]] != ""} {
return [JavaInitializer new $initVal]
}
return ""
}
# Do not delete this line -- regeneration end marker
if [isCommand CMDataAttr] {
Class JVGDataAttrD : {JVGDataAttr CMDataAttr} {
}
} else {
Class JVGDataAttrD : {JVGDataAttr OPDataAttr} {
}
}
global mostDerivedOOPL ; set mostDerivedOOPL(OPDataAttr) JVGDataAttrD
selfPromoter OPDataAttr {this} {
JVGDataAttrD promote $this
}
#---------------------------------------------------------------------------
# File: @(#)jvggenasso.tcl /main/titanic/8
Class JVGGenAssocAttr : {JVGAttribute} {
constructor
method destructor
method check
method generate
method generateAddAccessor
method generateGetAccessor
method generateGetManyAccessor
method generateRemoveAccessor
method generateSetAccessor
method generateAssociationVariable
method getAssocIdentifier
method getAssocVariable
method isClassFeature
method extendAssociation
method reduceAssociation
method setAssociation
}
constructor JVGGenAssocAttr {class this name} {
set this [JVGAttribute::constructor $class $this $name]
# Start constructor user section
# End constructor user section
return $this
}
method JVGGenAssocAttr::destructor {this} {
# Start destructor user section
# End destructor user section
}
method JVGGenAssocAttr::check {this} {
if [$this isClassFeature] {
if {[$this opposite] != ""} {
set className [[$this ooplClass] getName]
m4_warning $W_BIDIRSTATIC [$this getName] $className
}
}
}
method JVGGenAssocAttr::generate {this} {
# !! Implement this function !!
}
method JVGGenAssocAttr::generateAddAccessor {this} {
set ident [$this getAssocIdentifier]
if [$this isOrdered] {
set accessor [JavaAccMethod new "append[cap $ident]"]
} else {
set accessor [JavaAccMethod new "add[cap $ident]"]
}
[[$this ooplClass] container] addAssociationAccessor $accessor
if [$this isClassFeature] {
$accessor addModifier [JavaModifier new "static"]
}
$accessor type [JavaType new "void"]
if [$this isQualified] {
set qualifier [$this qualifier]
set qualTypeName [[$qualifier ooplType] getName]
set qualId "[$qualifier getName]_"
set type [JavaType new $qualTypeName]
$accessor addParameter [JavaParameter new $qualId $type]
}
set opposite [$this opposite]
if {$opposite != "" && [$opposite isQualified]} {
set qualTypeName [[[$opposite qualifier] ooplType] getName]
set qualId "[[$opposite qualifier] getName]_"
set type [JavaType new $qualTypeName]
$accessor addParameter [JavaParameter new $qualId $type]
}
set paramId "${ident}_"
set type [JavaType new [[$this ooplType] getName]]
$accessor addParameter [JavaParameter new $paramId $type]
set body [TextSection new]
$accessor generatorBody $body
$body append "if ($paramId == null)\n"
$body append " return;\n";
if {$opposite != ""} {
if {[$opposite getMultiplicity] == "one" &&
![$opposite isQualified] && ![$this isQualified]} {
$body append [$opposite setAssociation $paramId]
}
$body append [$opposite extendAssociation $paramId]
}
if [$this isQualified] {
[[$this ooplClass] container] needsVector 1
set varName [$this getAssocVariable]
$body append "// You must supply a hashCode and equals method for Object\n"
$body append "// [[$this qualifier] getName] for java.util.Hashtable usage.\n"
$body append "Vector vector = (Vector) $varName.get($qualId);\n"
$body append "if (vector == null) {\n"
$body append " vector = new Vector();\n"
$body append " $varName.put($qualId, vector);\n"
$body append "}\n"
$body append "vector.addElement($paramId);\n"
} else {
$body append [$this extendAssociation "" $paramId]
}
set access [$this getAccessorAccess w]
if {$access != "none"} {
$accessor access [JavaAccess new $access]
}
}
method JVGGenAssocAttr::generateGetAccessor {this} {
set varName [$this getAssocVariable]
set accessor [JavaAccMethod new "get[cap $varName]"]
[[$this ooplClass] container] addAssociationAccessor $accessor
if [$this isClassFeature] {
$accessor addModifier [JavaModifier new "static"]
}
$accessor type [JavaType new [[$this ooplType] getName]]
set access [$this getAccessorAccess r]
if {$access != "none"} {
$accessor access [JavaAccess new $access]
}
set body [TextSection new]
$body append "return $varName;\n"
$accessor generatorBody $body
}
method JVGGenAssocAttr::generateGetManyAccessor {this} {
set varName [$this getAssocVariable]
set accessor [JavaAccMethod new "get[cap $varName]"]
[[$this ooplClass] container] addAssociationAccessor $accessor
if [$this isClassFeature] {
$accessor addModifier [JavaModifier new "static"]
}
if [$this isOrdered] {
$accessor type [JavaType new "Queue"]
} else {
[[$this ooplClass] container] needsVector 1
$accessor type [JavaType new "Vector"]
}
set access [$this getAccessorAccess r]
if {$access != "none"} {
$accessor access [JavaAccess new $access]
}
set body [TextSection new]
$body append "return $varName;\n"
$accessor generatorBody $body
}
method JVGGenAssocAttr::generateRemoveAccessor {this} {
set ident [$this getAssocIdentifier]
set opposite [$this opposite]
set accessor [JavaAccMethod new "remove[cap $ident]"]
[[$this ooplClass] container] addAssociationAccessor $accessor
if [$this isClassFeature] {
$accessor addModifier [JavaModifier new "static"]
}
$accessor type [JavaType new "void"]
if {$opposite != "" && [$opposite isQualified]} {
set qualifier [$opposite qualifier]
set type [JavaType new [[$qualifier ooplType] getName]]
set qualId "[$qualifier getName]_"
$accessor addParameter [JavaParameter new $qualId $type]
}
set paramId "${ident}_"
set type [JavaType new [[$this ooplType] getName]]
$accessor addParameter [JavaParameter new $paramId $type]
set body [TextSection new]
$accessor generatorBody $body
$body append "if ($paramId == null)\n"
$body append " return;\n"
if {$opposite != ""} {
$body append [$opposite reduceAssociation $paramId]
}
$body append [$this reduceAssociation "" $paramId]
set access [$this getAccessorAccess w]
if {$access != "none"} {
$accessor access [JavaAccess new $access]
}
}
method JVGGenAssocAttr::generateSetAccessor {this} {
set opposite [$this opposite]
set ident [$this getAssocIdentifier]
set paramId "${ident}_"
set accessor [JavaAccMethod new "set[cap $ident]"]
[[$this ooplClass] container] addAssociationAccessor $accessor
if [$this isClassFeature] {
$accessor addModifier [JavaModifier new "static"]
}
$accessor type [JavaType new "void"]
set access [$this getAccessorAccess w]
if {$access != "none"} {
$accessor access [JavaAccess new $access]
}
if {$opposite != "" && [$opposite isQualified]} {
set qualifier [$opposite qualifier]
set type [JavaType new [[$qualifier ooplType] getName]]
set parameter [JavaParameter new "[$qualifier getName]_" $type]
$accessor addParameter $parameter
}
set type [JavaType new [[$this ooplType] getName]]
$accessor addParameter [JavaParameter new $paramId $type]
set body [TextSection new]
$accessor generatorBody $body
if {$opposite != ""} {
if [$opposite isQualified] {
$body append "if ($paramId != null)\n"
$body append " [$opposite extendAssociation $paramId]"
} else {
$body append "if ($ident != null)\n"
$body append " [$opposite reduceAssociation $ident]"
if {[$opposite getMultiplicity] == "one"} {
$body append "if ($paramId != null) {\n"
$body append " [$opposite setAssociation $paramId]"
$body append " [$opposite extendAssociation $paramId]"
$body append "}\n"
}
if {[$opposite getMultiplicity] == "many"} {
$body append "if ($paramId != null)\n"
$body append " [$opposite extendAssociation $paramId]"
}
}
}
$body append "$ident = $paramId;\n"
}
method JVGGenAssocAttr::generateAssociationVariable {this} {
set assocVar [JavaVariable new [$this getAssocVariable]]
if [$this isQualified] {
[[$this ooplClass] container] needsHashtable 1
$assocVar type [JavaType new "Hashtable"]
if [$this isClassFeature] {
$assocVar initializer [JavaInitializer new "new Hashtable()"]
}
} elseif {[$this getMultiplicity] == "many"} {
if [$this isOrdered] {
$assocVar type [JavaType new "Queue"]
if [$this isClassFeature] {
$assocVar initializer [JavaInitializer new "new Queue()"]
}
} else {
[[$this ooplClass] container] needsVector 1
$assocVar type [JavaType new "Vector"]
if [$this isClassFeature] {
$assocVar initializer [JavaInitializer new "new Vector()"]
}
}
} else {
$assocVar type [JavaType new [[$this ooplType] getName]]
}
[[$this ooplClass] container] addAssocVariable $assocVar
if {[$this opposite] != ""} {
set access "public"
} else {
set access [$this getAttributeAccess]
}
if {$access != "none"} {
if {$access == ""} {
set access "private"
}
$assocVar access [JavaAccess new $access]
}
if [$this isClassFeature] {
$assocVar addModifier [JavaModifier new "static"]
}
if [$this isThreadsafe] {
$assocVar addModifier [JavaModifier new "threadsafe"]
}
if [$this isTransient] {
$assocVar addModifier [JavaModifier new "transient"]
}
if [$this isVolatile] {
$assocVar addModifier [JavaModifier new "volatile"]
}
}
method JVGGenAssocAttr::getAssocIdentifier {this} {
if [$this isLinkAttr] {
return [uncap [[$this ooplType] getName]Of[cap [$this getName]]]
}
return [$this getName]
}
method JVGGenAssocAttr::getAssocVariable {this} {
if {[$this getMultiplicity] == "many"} {
return [$this getAssocIdentifier]Set
}
return [$this getAssocIdentifier]
}
method JVGGenAssocAttr::isClassFeature {this} {
if {[$this getPropertyValue "is_static"] == "1"} {
return "1"
}
return "0"
}
method JVGGenAssocAttr::extendAssociation {this {prefix ""} {element "this"}} {
set sect [TextSection new]
if {$prefix != ""} {
set prefix ${prefix}.
}
set varName [$this getAssocVariable]
if [$this isQualified] {
set qualId "[[$this qualifier] getName]_"
if {[$this getMultiplicity] == "one"} {
return "$prefix$varName.put($qualId, $element);\n"
}
set ident [$this getAssocIdentifier]
return "${prefix}add[cap $ident]($qualId, $element);\n"
}
if {[$this getMultiplicity] == "one"} {
return "$prefix$varName = $element;\n"
}
if [$this isOrdered] {
return "$prefix$varName.append($element);\n"
}
return "$prefix$varName.addElement($element);\n"
}
method JVGGenAssocAttr::reduceAssociation {this {prefix ""} {element "this"}} {
if {$prefix != ""} {
set prefix "${prefix}."
}
set varName [$this getAssocVariable]
if [$this isQualified] {
set qualId "[[$this qualifier] getName]_"
if {[$this getMultiplicity] == "one"} {
return "$prefix$varName.remove($qualId);\n"
}
set ident [$this getAssocIdentifier]
return "${prefix}remove[cap $ident]($qualId, $element);\n"
}
if {[$this getMultiplicity] == "one"} {
return "$prefix$varName = null;\n"
}
return "$prefix$varName.removeElement($element);\n"
}
method JVGGenAssocAttr::setAssociation {this {prefix ""} {element "null"}} {
if {$prefix != ""} {
set prefix "${prefix}."
}
return "${prefix}set[cap [$this getAssocIdentifier]]($element);\n"
}
# Do not delete this line -- regeneration end marker
if [isCommand CMGenAssocAttr] {
Class JVGGenAssocAttrD : {JVGGenAssocAttr CMGenAssocAttr} {
}
} else {
Class JVGGenAssocAttrD : {JVGGenAssocAttr OPGenAssocAttr} {
}
}
global mostDerivedOOPL ; set mostDerivedOOPL(OPGenAssocAttr) JVGGenAssocAttrD
selfPromoter OPGenAssocAttr {this} {
JVGGenAssocAttrD promote $this
}
#---------------------------------------------------------------------------
# File: @(#)jvgassocat.tcl /main/titanic/6
Class JVGAssocAttr : {JVGGenAssocAttr} {
constructor
method destructor
method generate
}
constructor JVGAssocAttr {class this name} {
set this [JVGGenAssocAttr::constructor $class $this $name]
# Start constructor user section
# End constructor user section
return $this
}
method JVGAssocAttr::destructor {this} {
# Start destructor user section
# End destructor user section
}
method JVGAssocAttr::generate {this} {
if [[$this ooplClass] isInterface] {
return
}
$this generateImportStatements
$this generateAssociationVariable
if {[$this getMultiplicity] == "one"} {
if {[$this getAccessorAccess r] != "none"} {
$this generateGetAccessor
}
if {[$this getAccessorAccess w] != "none"} {
$this generateSetAccessor
}
} else {
if {[$this getAccessorAccess w] != "none"} {
$this generateAddAccessor
$this generateRemoveAccessor
}
if {[$this getAccessorAccess r] != "none"} {
$this generateGetManyAccessor
}
}
}
# Do not delete this line -- regeneration end marker
if [isCommand CMAssocAttr] {
Class JVGAssocAttrD : {JVGAssocAttr CMAssocAttr} {
}
} else {
Class JVGAssocAttrD : {JVGAssocAttr OPAssocAttr} {
}
}
global mostDerivedOOPL ; set mostDerivedOOPL(OPAssocAttr) JVGAssocAttrD
selfPromoter OPAssocAttr {this} {
JVGAssocAttrD promote $this
}
#---------------------------------------------------------------------------
# File: @(#)jvglinkatt.tcl /main/titanic/4
Class JVGLinkAttr : {JVGGenAssocAttr} {
constructor
method destructor
method generate
}
constructor JVGLinkAttr {class this name} {
set this [JVGGenAssocAttr::constructor $class $this $name]
# Start constructor user section
# End constructor user section
return $this
}
method JVGLinkAttr::destructor {this} {
# Start destructor user section
# End destructor user section
}
method JVGLinkAttr::generate {this} {
if [[$this ooplClass] isInterface] {
return
}
$this generateImportStatements
$this generateAssociationVariable
if {[$this getMultiplicity] == "one"} {
$this generateGetAccessor
} else {
$this generateGetManyAccessor
}
}
# Do not delete this line -- regeneration end marker
if [isCommand CMLinkAttr] {
Class JVGLinkAttrD : {JVGLinkAttr CMLinkAttr} {
}
} else {
Class JVGLinkAttrD : {JVGLinkAttr OPLinkAttr} {
}
}
global mostDerivedOOPL ; set mostDerivedOOPL(OPLinkAttr) JVGLinkAttrD
selfPromoter OPLinkAttr {this} {
JVGLinkAttrD promote $this
}
#---------------------------------------------------------------------------
# File: @(#)jvgqualatt.tcl /main/titanic/11
Class JVGQualAttr : {JVGGenAssocAttr} {
constructor
method destructor
method check
method generate
method generateGetQualifiedAccessor
method generateImportStatements
method generateRemoveQualifiedAccessor
method generateSetQualifiedAccessor
}
constructor JVGQualAttr {class this name} {
set this [JVGGenAssocAttr::constructor $class $this $name]
# Start constructor user section
# End constructor user section
return $this
}
method JVGQualAttr::destructor {this} {
# Start destructor user section
# End destructor user section
}
method JVGQualAttr::check {this} {
#
# Check if qualifier has one of the Java builtin types.
# The type of a qualifier must be derived from Object.
#
set wrongTypes "byte short int long char float double boolean"
set qualifier [$this qualifier]
set qualName [$qualifier getName]
set qualType [$qualifier ooplType]
set qualTypeName [$qualType getName]
if {[lsearch $wrongTypes $qualTypeName] != -1} {
set item [[$this smConnector] getItem]
if [$item isNil] {
set itemName ""
} else {
set itemName [$item name]
}
m4_warning $W_QUALWRONGTYPE $qualName $itemName [$this getName] $qualTypeName
}
return [$this JVGGenAssocAttr::check]
}
method JVGQualAttr::generate {this} {
if [[$this ooplClass] isInterface] {
return
}
$this generateImportStatements
$this generateAssociationVariable
if {[$this getAccessorAccess r] != "none"} {
$this generateGetQualifiedAccessor
}
if {[$this getAccessorAccess w] != "none"} {
if {[$this getMultiplicity] == "one"} {
$this generateSetQualifiedAccessor
} else {
$this generateAddAccessor
}
$this generateRemoveQualifiedAccessor
}
}
method JVGQualAttr::generateGetQualifiedAccessor {this} {
set varName [$this getAssocVariable]
set assocType [$this ooplType]
set accessor [JavaAccMethod new "get[cap $varName]"]
[[$this ooplClass] container] addAssociationAccessor $accessor
if [$this isClassFeature] {
$accessor addModifier [JavaModifier new "static"]
}
if {[$this getMultiplicity] == "many"} {
[[$this ooplClass] container] needsVector 1
set assocTypeName "Vector"
} else {
set assocTypeName [$assocType getName]
}
set access [$this getAccessorAccess r]
if {$access != "none"} {
$accessor access [JavaAccess new $access]
}
$accessor type [JavaType new $assocTypeName]
set qualifier [$this qualifier]
set qualName [$qualifier getName]
set qualType [$qualifier ooplType]
set qualTypeName [$qualType getName]
set type [JavaType new $qualTypeName]
set qualId "${qualName}_"
$accessor addParameter [JavaParameter new $qualId $type]
set body [TextSection new]
$body append "Object object = $varName.get($qualId);\n"
$body append "if (object != null)\n"
$body append " return (($assocTypeName) object);\n"
$body append "return null;\n"
$accessor generatorBody $body
}
method JVGQualAttr::generateImportStatements {this} {
$this JVGFeature::generateImportStatements
set qualType [[$this qualifier] ooplType]
JVGObject::generateImportStatement $qualType [[$this ooplClass] unit]
}
method JVGQualAttr::generateRemoveQualifiedAccessor {this} {
set ident [$this getAssocIdentifier]
set accessor [JavaAccMethod new "remove[cap $ident]"]
[[$this ooplClass] container] addAssociationAccessor $accessor
if [$this isClassFeature] {
$accessor addModifier [JavaModifier new "static"]
}
$accessor type [JavaType new "void"]
set access [$this getAccessorAccess w]
if {$access != "none"} {
$accessor access [JavaAccess new $access]
}
set qualType [JavaType new [[[$this qualifier] ooplType] getName]]
set qualId "[[$this qualifier] getName]_"
$accessor addParameter [JavaParameter new $qualId $qualType]
set body [TextSection new]
set paramId "${ident}_"
set opposite [$this opposite]
set varName [$this getAssocVariable]
if {[$this getMultiplicity] == "one"} {
$body append "Object object = $varName.get($qualId);\n"
$body append "if (object == null)\n"
$body append " return;\n"
$body append [$this reduceAssociation]
if {$opposite != ""} {
set typeName [[$this ooplType] getName]
$body append "$typeName $paramId = ($typeName) object;\n"
}
} else {
[[$this ooplClass] container] needsVector 1
set type [JavaType new [[$this ooplType] getName]]
$accessor addParameter [JavaParameter new $paramId $type]
$body append "if ($paramId == null)\n"
$body append " return;\n"
$body append "Vector vector = (Vector) $varName.get($qualId);\n";
$body append "if (vector != null)\n";
$body append " vector.removeElement($paramId);\n"
}
if {$opposite != ""} {
$body append [$opposite reduceAssociation $paramId]
}
$accessor generatorBody $body
}
method JVGQualAttr::generateSetQualifiedAccessor {this} {
set ident [$this getAssocIdentifier]
set accessor [JavaAccMethod new "set[cap $ident]"]
set qualifier [$this qualifier]
set qualType [JavaType new [[$qualifier ooplType] getName]]
set qualId "[$qualifier getName]_"
[[$this ooplClass] container] addAssociationAccessor $accessor
if [$this isClassFeature] {
$accessor addModifier [JavaModifier new "static"]
}
$accessor addParameter [JavaParameter new $qualId $qualType]
$accessor type [JavaType new "void"]
set paramId "${ident}_"
set type [JavaType new [[$this ooplType] getName]]
$accessor addParameter [JavaParameter new $paramId $type]
set access [$this getAccessorAccess w]
if {$access != "none"} {
$accessor access [JavaAccess new $access]
}
set body [TextSection new]
$body append "remove[cap $ident]($qualId);\n"
$body append "if ($paramId == null)\n"
$body append " return;\n"
$body append "$ident.put($qualId, $paramId);\n"
set opposite [$this opposite]
if {$opposite != ""} {
$body append [$opposite extendAssociation $paramId]
}
$accessor generatorBody $body
}
# Do not delete this line -- regeneration end marker
if [isCommand CMQualAttr] {
Class JVGQualAttrD : {JVGQualAttr CMQualAttr} {
}
} else {
Class JVGQualAttrD : {JVGQualAttr OPQualAttr} {
}
}
global mostDerivedOOPL ; set mostDerivedOOPL(OPQualAttr) JVGQualAttrD
selfPromoter OPQualAttr {this} {
JVGQualAttrD promote $this
}
#---------------------------------------------------------------------------
# File: @(#)jvgreverse.tcl /main/titanic/4
Class JVGReverseLinkAttr : {JVGGenAssocAttr} {
constructor
method destructor
method generate
}
constructor JVGReverseLinkAttr {class this name} {
set this [JVGGenAssocAttr::constructor $class $this $name]
# Start constructor user section
# End constructor user section
return $this
}
method JVGReverseLinkAttr::destructor {this} {
# Start destructor user section
# End destructor user section
}
method JVGReverseLinkAttr::generate {this} {
if [[$this ooplClass] isInterface] {
return
}
$this generateImportStatements
$this generateAssociationVariable
if {[$this getMultiplicity] == "one"} {
$this generateGetAccessor
} else {
$this generateGetManyAccessor
}
}
# Do not delete this line -- regeneration end marker
if [isCommand CMReverseLinkAttr] {
Class JVGReverseLinkAttrD : {JVGReverseLinkAttr CMReverseLinkAttr} {
}
} else {
Class JVGReverseLinkAttrD : {JVGReverseLinkAttr OPReverseLinkAttr} {
}
}
global mostDerivedOOPL ; set mostDerivedOOPL(OPReverseLinkAttr) JVGReverseLinkAttrD
selfPromoter OPReverseLinkAttr {this} {
JVGReverseLinkAttrD promote $this
}
#---------------------------------------------------------------------------
# File: @(#)jvgqualass.tcl /main/titanic/3
Class JVGQualAssocAttr : {JVGQualAttr} {
constructor
method destructor
method generate
}
constructor JVGQualAssocAttr {class this name} {
set this [JVGQualAttr::constructor $class $this $name]
# Start constructor user section
# End constructor user section
return $this
}
method JVGQualAssocAttr::destructor {this} {
# Start destructor user section
# End destructor user section
}
method JVGQualAssocAttr::generate {this} {
$this JVGQualAttr::generate
}
# Do not delete this line -- regeneration end marker
if [isCommand CMQualAssocAttr] {
Class JVGQualAssocAttrD : {JVGQualAssocAttr CMQualAssocAttr} {
}
} else {
Class JVGQualAssocAttrD : {JVGQualAssocAttr OPQualAssocAttr} {
}
}
global mostDerivedOOPL ; set mostDerivedOOPL(OPQualAssocAttr) JVGQualAssocAttrD
selfPromoter OPQualAssocAttr {this} {
JVGQualAssocAttrD promote $this
}
#---------------------------------------------------------------------------
# File: @(#)jvgquallin.tcl /main/titanic/3
Class JVGQualLinkAttr : {JVGQualAttr} {
constructor
method destructor
method generate
}
constructor JVGQualLinkAttr {class this name} {
set this [JVGQualAttr::constructor $class $this $name]
# Start constructor user section
# End constructor user section
return $this
}
method JVGQualLinkAttr::destructor {this} {
# Start destructor user section
# End destructor user section
}
method JVGQualLinkAttr::generate {this} {
$this JVGQualAttr::generate
}
# Do not delete this line -- regeneration end marker
if [isCommand CMQualLinkAttr] {
Class JVGQualLinkAttrD : {JVGQualLinkAttr CMQualLinkAttr} {
}
} else {
Class JVGQualLinkAttrD : {JVGQualLinkAttr OPQualLinkAttr} {
}
}
global mostDerivedOOPL ; set mostDerivedOOPL(OPQualLinkAttr) JVGQualLinkAttrD
selfPromoter OPQualLinkAttr {this} {
JVGQualLinkAttrD promote $this
}