PC World 1998 October/PCWorld_1998-10_cd.bin/software/prehled/komix/DATA.Z/pboopl.tcl

Text File | 1997-11-07 | 112KB | 4,095 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            : pboopl.tcl
#       Author          :
#       Original date   : November 1997
#       Description     : Classes for code generation
#
#---------------------------------------------------------------------------


#      File:           @(#)pbgassocin.tcl    /main/titanic/3


Class PBGAssocInitializer : {Object} {
    constructor
    method destructor
}

constructor PBGAssocInitializer {class this name} {
    set this [Object::constructor $class $this $name]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBGAssocInitializer::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

# Do not delete this line -- regeneration end marker

if [isCommand CMAssocInitializer] {
    Class  PBGAssocInitializerD : {PBGAssocInitializer CMAssocInitializer} {
    }
} else {
    Class PBGAssocInitializerD : {PBGAssocInitializer OPAssocInitializer} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPAssocInitializer) PBGAssocInitializerD

selfPromoter OPAssocInitializer {this} {
    PBGAssocInitializerD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)pbgattribi.tcl    /main/titanic/3


Class PBGAttribInitializer : {Object} {
    constructor
    method destructor
}

constructor PBGAttribInitializer {class this name} {
    set this [Object::constructor $class $this $name]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBGAttribInitializer::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

# Do not delete this line -- regeneration end marker

if [isCommand CMAttribInitializer] {
    Class  PBGAttribInitializerD : {PBGAttribInitializer CMAttribInitializer} {
    }
} else {
    Class PBGAttribInitializerD : {PBGAttribInitializer OPAttribInitializer} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPAttribInitializer) PBGAttribInitializerD

selfPromoter OPAttribInitializer {this} {
    PBGAttribInitializerD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)pbgclass.tcl    /main/titanic/10


Class PBGClass : {Object} {
    constructor
    method destructor
    method promoter
    method generate
    method generateAsContainedClass
    method getPBClassKind
    method getSuperClass
    method getBuiltinSuperClass
    method getBuiltinSuperClassName
    method hasEvent
    method isGlobalType
    method isAutoInstantiate
    method getWindowType
    method isBuiltin
    method check
    method checkLocal
    method checkContLoop
    method checkPBClassKind
    method checkBuiltinSuperClass
    method checkInheritanceLoop
    method checkClassKind
    method checkSuperClass
    method checkSuperGlobal
    method checkSuperPresence
    method checkMultipleInheritance
    method checkAsContainedClass
    method addContainedTypeName
    method removeContainedTypeName
    attribute pbClassKind
    attribute superClass
    attribute builtinSuperClass
    attribute inhLoopDetect
    attribute containLoopDetect
    attribute containedTypeNameSet
}

constructor PBGClass {class this name} {
    set this [Object::constructor $class $this $name]
    $this pbClassKind ""
    $this superClass "_uninitialized_"
    $this builtinSuperClass "_uninitialized_"
    $this inhLoopDetect 0
    $this containLoopDetect 0
    $this containedTypeNameSet [List new]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBGClass::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

method PBGClass::promoter {this} {
    $this pbClassKind ""
    $this superClass "_uninitialized_"
    $this builtinSuperClass "_uninitialized_"
    $this inhLoopDetect 0
    $this containLoopDetect 0
    $this containedTypeNameSet [List new]
}

method PBGClass::generate {this model} {
    # first determine the kind of entry class,
    # and then call the appropiate generation.



    if {[$this checkLocal] != 0 } {
        # could not generate
        return ""
    } else {
        set kind [$this getPBClassKind]

        if {$kind == ${PBClassKind::NotSupported}} {
            return ""
        }

        set name [$this getName]
        $this superClass [$this getSuperClass]
        set superNm [[$this superClass] getName]

        # appropiate generation:
        set pbDefGen [PB${kind}Gen new $name $this \
                          -superNm $superNm \
                          -isGlobalType 1 \
                          -globalOoplClass $this \
                          -container "" \
                          -model $model]

        return [$pbDefGen generate]
    }
    return ""
}

method PBGClass::generateAsContainedClass {this name globalOoplClass fromOoplClass container} {
    set kind [$this getPBClassKind]
    if {$kind == ${PBClassKind::NotSupported}} {
        return ""
    }
    if [$this containLoopDetect] {
        # error already given: E_GRCONTLOOP
        return ""
    }

    if {[$this isBuiltin] || [$this isGlobalType]} {
        # pb internal lower cases class names
        set superNm [string tolower [$this getName]]
    } else {
        # pb internal lower cases class names
        set superNm [string tolower [[$this getSuperClass] getName]]
    }

    if {$name == $superNm} {
        # error already given: E_INVALIDLOCTYPE
        return ""
    }
    set typeNames [$globalOoplClass containedTypeNameSet]
    # current $name already in contained set because it is already
    #  added in checkAsContainedClass
    #  so error was :already given: $E_MULTDEFLOCTYPES

    set pbDefGen [PB${kind}Gen new $name $this \
        -superNm $superNm \
        -isGlobalType 0 \
        -globalOoplClass $globalOoplClass \
        -container $container \
        -model ""]

    $this containLoopDetect 1
    set def [$pbDefGen generate]
    $this containLoopDetect 0

    return $def
}

method PBGClass::getPBClassKind {this} {
    if {[$this pbClassKind] != ""} {
        return [$this pbClassKind]
    }

    if {[$this getBuiltinSuperClass] == ""} {
        $this pbClassKind ${PBClassKind::NotSupported}
        return [$this pbClassKind]
    }

    if {[$this checkSuperGlobal] != 0} {
        $this pbClassKind ${PBClassKind::NotSupported}
        return [$this pbClassKind]
    }

    set builtinSuperNm [$this getBuiltinSuperClassName]
    set classInfo [[PBBuiltinInfo::global] getBuiltinClass $builtinSuperNm]
    if {$classInfo == ""} {
        m4_error $E_INVALBUILTINSUPER [$this getName] $builtinSuperNm
        $this pbClassKind ${PBClassKind::NotSupported}
    } else {
        $this pbClassKind [$classInfo kind]
    }
    return [$this pbClassKind]
}

method PBGClass::getSuperClass {this} {
    if {[$this superClass] != "_uninitialized_"} {
        return [$this superClass]
    }

    if {[string tolower [$this getName]] == "powerobject"} {
        # this is THE root class
        $this superClass ""
        return ""
    }
    set genNodeSet [$this genNodeSet]
    if {[llength $genNodeSet] == 0} {
        set superClass [[$this ooplModel] classByName "nonvisualobject"]
        $this superClass $superClass
        return $superClass
    }
    # just calling check:
    # set errornr [$this checkMultipleInheritance]
    # there are (multiple) superclas(ses) so take first:
    $this superClass [[lindex $genNodeSet 0] superClass]
    return [[lindex $genNodeSet 0] superClass]
}

method PBGClass::getBuiltinSuperClass {this} {
    if {[$this builtinSuperClass] != "_uninitialized_"} {
        return [$this builtinSuperClass]
    }
    if [$this isBuiltin] {
        $this builtinSuperClass $this
        return $this
    }
    set superClass [$this getSuperClass]
    if {$superClass != ""} {
        # now recursive call method:
        set builtinSuperClass [$superClass getBuiltinSuperClass]
        $this builtinSuperClass $builtinSuperClass
        $this inhLoopDetect 0
        return $builtinSuperClass
    }
    # if reaching this point then serious error....
    $this builtinSuperClass ""
    $this inhLoopDetect 0
    return ""
}

method PBGClass::getBuiltinSuperClassName {this} {
    set class [$this getBuiltinSuperClass]
    if {$class == ""} {
        return ""
    }
    return [$class getName]
}

method PBGClass::hasEvent {this name} {
    set name [string tolower $name]

    foreach oper [$this operationSet] {
        if {[$oper isEvent] &&
                [string tolower [$oper getName]] == $name} {
            return 1
        }
    }
    return 0
}

method PBGClass::isGlobalType {this} {
    if {[$this getPropertyValue is_global_type] == "No"} {
        return 0
    }
    if [$this isBuiltin] {
        # The 'is_global_type' property does not apply to builtin
        # classes, so they do not have the property set to 'No'.
        # They must not be interpreted as global types however.
        return 0
    }
    return 1
}

method PBGClass::isAutoInstantiate {this} {
    if {[$this getPropertyValue is_autoinstantiate] == "1"} {
        return 1
    }
    return 0
}

method PBGClass::getWindowType {this} {
    set windowType [$this getPropertyValue window_type]
    if {$windowType == ""} {
        set windowType "Main"
    }
    return $windowType
}

method PBGClass::isBuiltin {this} {
    if {[$this getPropertyValue is_builtin] == "1"} {
        return 1
    }
    return 0
}

method PBGClass::check {this} {
    set errornr 0
    if ![$this isGlobalType] {
        # puts "skipping langdep-check for non-global class [$this getName]"
    } elseif [$this isExternal] {
        # puts "warning: external class [$this getName] will not be checked"
    } elseif {[$this getName] == ""} {
        m4_warning $W_CLASS_WITHOUT_NAME
        incr errornr 1
    } else {
        # now the real checking:
        incr errornr [$this checkLocal]
    }
    # puts "Class: [$this getName]    Errors: $errornr"
    return $errornr
}

method PBGClass::checkLocal {this} {
    set errornr 0
    set warningnr 0
    # first check the class kind and inheritance

    set tmpError [$this checkSuperClass]
    incr errornr $tmpError
    if {$tmpError == 0} {
        incr errornr [$this checkPBClassKind]
    }
    # secondly after the first checks went ok
    #  then do the PBDefinitionGen checks.
    if {$errornr == 0} {

        # all already valid, because already tested:
        set kind [$this getPBClassKind]
        set name [$this getName]
        $this superClass [$this getSuperClass]
        set superNm [[$this superClass] getName]
        # appropiate generation:
        set pbDefGen [PB${kind}Gen new $name $this \
                          -superNm $superNm \
                          -isGlobalType 1 \
                          -globalOoplClass $this \
                          -container "" \
                          -model ""]

        $this containLoopDetect 1
        incr errornr [$pbDefGen check]
        $this containLoopDetect 0
    }
    return $errornr
}

method PBGClass::checkContLoop {this} {

}

method PBGClass::checkPBClassKind {this} {
    set errornr 0

    # if no builtin root then error:
    if {[$this checkBuiltinSuperClass] != 0} {
        incr errornr 1
        return $errornr
    }

    set superClass [$this getSuperClass]
    if {$superClass == ""} {
        incr errornr 1
    } else {
        if {![$superClass isBuiltin] && ![$superClass isGlobalType]} {
            # puts "no builtin or global"
            incr errornr 1
            return $errornr
        }
        set builtinSuperNm [$this getBuiltinSuperClassName]
        set classInfo [[PBBuiltinInfo::global] getBuiltinClass $builtinSuperNm]
        if {$classInfo == ""} {
            m4_error $E_INVALBUILTINSUPER [$this getName] $builtinSuperNm
            incr errornr 1
        }
    }
    return $errornr
}

method PBGClass::checkBuiltinSuperClass {this {recursive 0}} {
    set errornr 0
    set chkBuiltinSuperClass 0
    if {[$this inhLoopDetect] == 1} {
        incr errornr 1
    } elseif {[$this isBuiltin] && !$recursive } {
        # when checking non-superclass these may not be builtins.
        $this builtinSuperClass ""
        incr errornr 1
       } elseif {[$this isBuiltin] && $recursive } {
        # superclass of builtin class is empty for generator
        $this builtinSuperClass $this
        incr errornr 0
    } elseif {[$this getSuperClass] != ""} {
        $this inhLoopDetect 1
        # now recursive call method:
        set chkBuiltinSuperClass [[$this getSuperClass] checkBuiltinSuperClass 1]
        incr errornr $chkBuiltinSuperClass
        $this inhLoopDetect 0
    }
    return $errornr
}

method PBGClass::checkInheritanceLoop {this} {
    set errornr 0
    if {[$this inhLoopDetect] == 1} {
        # error is already given by ooplModel ...
        #  m4_error $E_INHLOOP [$this getName]
        incr errornr 1
    } elseif [$this isBuiltin] {
        # builtin class so this one cannot have supers.
        #  if nevertherless drawed...............
        # incr errornr 0
    } elseif {[string tolower [$this getName]] == "powerobject"} {
        # this is THE root class
        # incr errornr 0
    } else {
        # and now the real checking:
        $this inhLoopDetect 1
        set superClass [$this getSuperClass]
        if {$superClass != ""} {
            incr errornr [$superClass checkInheritanceLoop]
        }
        # else top of tree
        $this inhLoopDetect 0
    }
    return $errornr
}

method PBGClass::checkClassKind {this} {
    set errornr 0

    set tmpError [$this checkBuiltinSuperClass]
    if { $tmpError != 0} {
        # puts "not supported"
        incr errornr $tmpError
    }
    return $errornr
}

method PBGClass::checkSuperClass {this} {
    set warningnr 0
    set errornr 0

    incr warningnr [$this checkSuperPresence]
    incr errornr [$this checkSuperGlobal]
    incr errornr [$this checkMultipleInheritance]

    return $errornr
}

method PBGClass::checkSuperGlobal {this} {
    set errornr 0

    if {[string tolower [$this getName]] != "powerobject"} {
        set superClass [$this getSuperClass]

        if {![$superClass isBuiltin] && ![$superClass isGlobalType]} {
            m4_error $E_NONGLOBALSUPER [$this getName] [$superClass getName]
            incr errornr 1
        }
    }
    return $errornr
}

method PBGClass::checkSuperPresence {this} {
    set warningnr 0
    if {[string tolower [$this getName]] != "powerobject"} {
        set genNodeSet [$this genNodeSet]
        if {[llength $genNodeSet] == 0} {
            m4_warning $W_NOSUPERCLASS [$this getName]
            incr warningnr 1
        }
    }
    return $warningnr
}

method PBGClass::checkMultipleInheritance {this} {
    set errornr 0
    set genNodeSet [$this genNodeSet]
    if {[llength $genNodeSet] > 1} {
        m4_error $E_NOMULTINH [$this getName]
        incr errornr 1
    }
    return $errornr
}

method PBGClass::checkAsContainedClass {this name globalOoplClass fromOoplClass container} {
    set errornr 0
    set kind [$this getPBClassKind]
    if {$kind == ${PBClassKind::NotSupported}} {
        # warning/error already given
        incr errornr 0
        return $errornr
    }
    if [$this containLoopDetect] {
        m4_error $E_GRCONTLOOP [$this getName]
        incr errornr 1
        return $errornr
    }

    if {[$this isBuiltin] || [$this isGlobalType]} {
        set superNm [$this getName]
    } else {
        set superNm [[$this getSuperClass] getName]
    }

    if {$name == $superNm} {
        m4_error $E_INVALIDLOCTYPE $name [$fromOoplClass getName] \
            [$this getName] [$globalOoplClass getName]
        incr errornr 1
        return $errornr
    }
    set typeNames [$globalOoplClass containedTypeNameSet]
    if {[$typeNames search $name] != -1 ||
            $name == [$globalOoplClass getName]} {
        m4_error $E_MULTDEFLOCTYPES $name [$fromOoplClass getName] \
            [$this getName] [$globalOoplClass getName]
        incr errornr 1
        return $errornr
    } else {
        $typeNames append $name
    }

    set pbDefGen [PB${kind}Gen new $name $this \
        -superNm $superNm \
        -isGlobalType 0 \
        -globalOoplClass $globalOoplClass \
        -container $container \
        -model ""]

    $this containLoopDetect 1
    incr errornr [$pbDefGen check]
    $this containLoopDetect 0

    return $errornr
}

# Do not delete this line -- regeneration end marker

if [isCommand CMClass] {
    Class  PBGClassD : {PBGClass CMClass} {
    }
} else {
    Class PBGClassD : {PBGClass OPClass} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPClass) PBGClassD

selfPromoter OPClass {this} {
    PBGClassD promote $this
}
method PBGClass::addContainedTypeName {this newContainedTypeName} {
    [$this containedTypeNameSet] append $newContainedTypeName

}

method PBGClass::removeContainedTypeName {this oldContainedTypeName} {
    [$this containedTypeNameSet] removeValue $oldContainedTypeName
}



#---------------------------------------------------------------------------
#      File:           @(#)pbgfeature.tcl    /main/titanic/3


Class PBGFeature : {Object} {
    constructor
    method destructor
    method check
    method checkLocal
}

constructor PBGFeature {class this name} {
    set this [Object::constructor $class $this $name]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBGFeature::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

method PBGFeature::check {this class} {
    set errornr 0
    incr errornr [$this checkLocal $class]
    return $errornr
}

method PBGFeature::checkLocal {this class} {
    set errornr 0
    return $errornr
}

# Do not delete this line -- regeneration end marker

if [isCommand CMFeature] {
    Class  PBGFeatureD : {PBGFeature CMFeature} {
    }
} else {
    Class PBGFeatureD : {PBGFeature OPFeature} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPFeature) PBGFeatureD

selfPromoter OPFeature {this} {
    PBGFeatureD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)pbgparamet.tcl    /main/titanic/3


Class PBGParameter : {Object} {
    constructor
    method destructor
    method check
    method checkLocal
}

constructor PBGParameter {class this name} {
    set this [Object::constructor $class $this $name]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBGParameter::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

method PBGParameter::check {this} {
    # !! Implement this function !!
}

method PBGParameter::checkLocal {this} {
    # !! Implement this function !!
}

# Do not delete this line -- regeneration end marker

if [isCommand CMParameter] {
    Class  PBGParameterD : {PBGParameter CMParameter} {
    }
} else {
    Class PBGParameterD : {PBGParameter OPParameter} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPParameter) PBGParameterD

selfPromoter OPParameter {this} {
    PBGParameterD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)pbgqualini.tcl    /main/titanic/3


Class PBGQualInitializer : {Object} {
    constructor
    method destructor
}

constructor PBGQualInitializer {class this name} {
    set this [Object::constructor $class $this $name]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBGQualInitializer::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

# Do not delete this line -- regeneration end marker

if [isCommand CMQualInitializer] {
    Class  PBGQualInitializerD : {PBGQualInitializer CMQualInitializer} {
    }
} else {
    Class PBGQualInitializerD : {PBGQualInitializer OPQualInitializer} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPQualInitializer) PBGQualInitializerD

selfPromoter OPQualInitializer {this} {
    PBGQualInitializerD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)pbgsupercl.tcl    /main/titanic/3


Class PBGSuperClassInitializer : {Object} {
    constructor
    method destructor
}

constructor PBGSuperClassInitializer {class this name} {
    set this [Object::constructor $class $this $name]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBGSuperClassInitializer::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

# Do not delete this line -- regeneration end marker

if [isCommand CMSuperClassInitializer] {
    Class  PBGSuperClassInitializerD : {PBGSuperClassInitializer CMSuperClassInitializer} {
    }
} else {
    Class PBGSuperClassInitializerD : {PBGSuperClassInitializer OPSuperClassInitializer} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPSuperClassInitializer) PBGSuperClassInitializerD

selfPromoter OPSuperClassInitializer {this} {
    PBGSuperClassInitializerD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)pbgtype.tcl    /main/titanic/4


Class PBGType : {Object} {
    constructor
    method destructor
    method check
    method checkLocal
    attribute arrayDesc
}

constructor PBGType {class this name} {
    set this [Object::constructor $class $this $name]
    $this arrayDesc ""
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBGType::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

method PBGType::check {this} {
    # !! Implement this function !!
}

method PBGType::checkLocal {this} {
    # !! Implement this function !!
}

# Do not delete this line -- regeneration end marker

if [isCommand CMType] {
    Class  PBGTypeD : {PBGType CMType} {
    }
} else {
    Class PBGTypeD : {PBGType OPType} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPType) PBGTypeD

selfPromoter OPType {this} {
    PBGTypeD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)pbbuiltinc.tcl    /main/titanic/5


Class PBBuiltinClass : {GCObject} {
    constructor
    method destructor
    method getMandatoryProp
    method setMandatoryProp
    method removeMandatoryProp
    attribute name
    attribute kind
    attribute isControl
    attribute isGrContainer
    attribute hasCtorDtor
    attribute initialOnCreateResidue
    attribute initialOnDestroyResidue
    attribute mandatoryProp
}

constructor PBBuiltinClass {class this i_name} {
    set this [GCObject::constructor $class $this]
    $this isControl 0
    $this isGrContainer 0
    $this hasCtorDtor 0
    $this name $i_name
    $this mandatoryProp [Dictionary new]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBBuiltinClass::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

# Do not delete this line -- regeneration end marker

method PBBuiltinClass::getMandatoryProp {this name} {
    return [[$this mandatoryProp] set $name]
}

method PBBuiltinClass::setMandatoryProp {this name newMandatoryProp} {
    [$this mandatoryProp] set $name $newMandatoryProp
}

method PBBuiltinClass::removeMandatoryProp {this name} {
    [$this mandatoryProp] unset $name
}



#---------------------------------------------------------------------------
#      File:           @(#)pbbuiltini.tcl    /main/titanic/6
# End user added include file section


Class PBBuiltinInfo : {GCObject} {
    constructor
    method destructor
    method getBuiltinClass
    method setBuiltinClass
    method removeBuiltinClass
    attribute builtinClass
}

global PBBuiltinInfo::instance
set PBBuiltinInfo::instance ""


constructor PBBuiltinInfo {class this} {
    set this [GCObject::constructor $class $this]
    $this builtinClass [Dictionary new]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBBuiltinInfo::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

proc PBBuiltinInfo::global {} {
    if {${PBBuiltinInfo::instance} != ""} {
        return ${PBBuiltinInfo::instance}
    }

    set instance [PBBuiltinInfo new]
    set PBBuiltinInfo::instance $instance

    # Fill it ...
    #
    set class [PBBuiltinClass new checkbox \
        -kind ${PBClassKind::VSUserObject} -isControl 1 -hasCtorDtor 1]
    $instance setBuiltinClass checkbox $class
    $class setMandatoryProp Width [PBBuiltinProperty new Width int 247]
    $class setMandatoryProp Height [PBBuiltinProperty new Height int 77]
    $class setMandatoryProp Text [ \
        PBBuiltinProperty new Text string \"none\"]

    set class [PBBuiltinClass new commandbutton \
        -kind ${PBClassKind::VSUserObject}  -isControl 1 -hasCtorDtor 1]
    $instance setBuiltinClass commandbutton $class
    $class setMandatoryProp Width [PBBuiltinProperty new Width int 247]
    $class setMandatoryProp Height [PBBuiltinProperty new Height int 109]
    $class setMandatoryProp Text [ \
        PBBuiltinProperty new Text string \"none\"]

    set class [PBBuiltinClass new connection \
        -kind ${PBClassKind::CSUserObject} -hasCtorDtor 1]
    $instance setBuiltinClass connection $class

    set class [PBBuiltinClass new datastore \
        -kind ${PBClassKind::CSUserObject} -hasCtorDtor 1]
    $instance setBuiltinClass datastore $class

        set class [PBBuiltinClass new datawindow \
                -kind ${PBClassKind::VSUserObject} -isControl 1 -hasCtorDtor 1]
        $instance setBuiltinClass datawindow $class
        $class setMandatoryProp Width [PBBuiltinProperty new Width int 494]
        $class setMandatoryProp Height [PBBuiltinProperty new Height int 361]

    set class [PBBuiltinClass new dropdownlistbox \
        -kind ${PBClassKind::VSUserObject} -isControl 1 -hasCtorDtor 1]
    $instance setBuiltinClass dropdownlistbox $class
    $class setMandatoryProp Width [PBBuiltinProperty new Width int 247]
    $class setMandatoryProp Height [PBBuiltinProperty new Height int 229]

    set class [PBBuiltinClass new dropdownpicturelistbox \
        -kind ${PBClassKind::VSUserObject} -isControl 1  -hasCtorDtor 1]
    $instance setBuiltinClass dropdownpicturelistbox $class
    $class setMandatoryProp Width [PBBuiltinProperty new Width int 247]
    $class setMandatoryProp Height [PBBuiltinProperty new Height int 229]

    set class [PBBuiltinClass new dynamicdescriptionarea \
        -kind ${PBClassKind::VSUserObject}  -hasCtorDtor 1]
    $instance setBuiltinClass dynamicdescriptionarea $class

    set class [PBBuiltinClass new dynamicstagingarea \
        -kind ${PBClassKind::VSUserObject}  -hasCtorDtor 1]
    $instance setBuiltinClass dynamicstagingarea $class

    set class [PBBuiltinClass new editmask \
        -kind ${PBClassKind::VSUserObject} -isControl 1 -hasCtorDtor 1]
    $instance setBuiltinClass editmask $class
    $class setMandatoryProp Width [PBBuiltinProperty new Width int 247]
    $class setMandatoryProp Height [PBBuiltinProperty new Height int 101]

    set class [PBBuiltinClass new error \
        -kind ${PBClassKind::CSUserObject} -hasCtorDtor 1]
    $instance setBuiltinClass error $class

    set class [PBBuiltinClass new graph \
        -kind ${PBClassKind::VSUserObject} -isControl 1 -hasCtorDtor 1]
    $instance setBuiltinClass graph $class
    $class setMandatoryProp Width [PBBuiltinProperty new Width int 988]
    $class setMandatoryProp Height [PBBuiltinProperty new Height int 721]
    $class setMandatoryProp Title [ \
        PBBuiltinProperty new Title string \"(None)\"]
    $class setMandatoryProp GraphType [ \
        PBBuiltinProperty new GraphType grGraphType ColGraph!]
    set sect [TextSection new]
    $class initialOnCreateResidue $sect
    expand_text $sect {
        TitleDispAttr = create grDispAttr
        LegendDispAttr = create grDispAttr
        PieDispAttr = create grDispAttr
        Series = create grAxis
        Series.DispAttr = create grDispAttr
        Series.LabelDispAttr = create grDispAttr
        Category = create grAxis
        Category.DispAttr = create grDispAttr
        Category.LabelDispAttr = create grDispAttr
        Values = create grAxis
        Values.DispAttr = create grDispAttr
        Values.LabelDispAttr = create grDispAttr
        TitleDispAttr.Weight=700
        TitleDispAttr.FaceName="Arial"
        TitleDispAttr.FontFamily=Swiss!
        TitleDispAttr.FontPitch=Variable!
        TitleDispAttr.Alignment=Center!
        TitleDispAttr.BackColor=536870912
        TitleDispAttr.Format="[General]"
        TitleDispAttr.DisplayExpression="title"
        TitleDispAttr.AutoSize=true
        Category.Label="(None)"
        Category.AutoScale=true
        Category.ShadeBackEdge=true
        Category.SecondaryLine=transparent!
        Category.MajorGridLine=transparent!
        Category.MinorGridLine=transparent!
        Category.DropLines=transparent!
        Category.OriginLine=transparent!
        Category.MajorTic=Outside!
        Category.DataType=adtText!
        Category.DispAttr.Weight=400
        Category.DispAttr.FaceName="Arial"
        Category.DispAttr.FontFamily=Swiss!
        Category.DispAttr.FontPitch=Variable!
        Category.DispAttr.Alignment=Center!
        Category.DispAttr.BackColor=536870912
        Category.DispAttr.Format="[General]"
        Category.DispAttr.DisplayExpression="category"
        Category.DispAttr.AutoSize=true
        Category.LabelDispAttr.Weight=400
        Category.LabelDispAttr.FaceName="Arial"
        Category.LabelDispAttr.FontFamily=Swiss!
        Category.LabelDispAttr.FontPitch=Variable!
        Category.LabelDispAttr.Alignment=Center!
        Category.LabelDispAttr.BackColor=536870912
        Category.LabelDispAttr.Format="[General]"
        Category.LabelDispAttr.DisplayExpression="categoryaxislabel"
        Category.LabelDispAttr.AutoSize=true
        Values.Label="(None)"
        Values.AutoScale=true
        Values.SecondaryLine=transparent!
        Values.MajorGridLine=transparent!
        Values.MinorGridLine=transparent!
        Values.DropLines=transparent!
        Values.MajorTic=Outside!
        Values.DataType=adtDouble!
        Values.DispAttr.Weight=400
        Values.DispAttr.FaceName="Arial"
        Values.DispAttr.FontFamily=Swiss!
        Values.DispAttr.FontPitch=Variable!
        Values.DispAttr.Alignment=Right!
        Values.DispAttr.BackColor=536870912
        Values.DispAttr.Format="[General]"
        Values.DispAttr.DisplayExpression="value"
        Values.DispAttr.AutoSize=true
        Values.LabelDispAttr.Weight=400
        Values.LabelDispAttr.FaceName="Arial"
        Values.LabelDispAttr.FontFamily=Swiss!
        Values.LabelDispAttr.FontPitch=Variable!
        Values.LabelDispAttr.Alignment=Center!
        Values.LabelDispAttr.BackColor=536870912
        Values.LabelDispAttr.Format="[General]"
        Values.LabelDispAttr.DisplayExpression="valuesaxislabel"
        Values.LabelDispAttr.AutoSize=true
        Values.LabelDispAttr.Escapement=900
        Series.Label="(None)"
        Series.AutoScale=true
        Series.SecondaryLine=transparent!
        Series.MajorGridLine=transparent!
        Series.MinorGridLine=transparent!
        Series.DropLines=transparent!
        Series.OriginLine=transparent!
        Series.MajorTic=Outside!
        Series.DataType=adtText!
        Series.DispAttr.Weight=400
        Series.DispAttr.FaceName="Arial"
        Series.DispAttr.FontFamily=Swiss!
        Series.DispAttr.FontPitch=Variable!
        Series.DispAttr.BackColor=536870912
        Series.DispAttr.Format="[General]"
        Series.DispAttr.DisplayExpression="series"
        Series.DispAttr.AutoSize=true
        Series.LabelDispAttr.Weight=400
        Series.LabelDispAttr.FaceName="Arial"
        Series.LabelDispAttr.FontFamily=Swiss!
        Series.LabelDispAttr.FontPitch=Variable!
        Series.LabelDispAttr.Alignment=Center!
        Series.LabelDispAttr.BackColor=536870912
        Series.LabelDispAttr.Format="[General]"
        Series.LabelDispAttr.DisplayExpression="seriesaxislabel"
        Series.LabelDispAttr.AutoSize=true
        LegendDispAttr.Weight=400
        LegendDispAttr.FaceName="Arial"
        LegendDispAttr.FontFamily=Swiss!
        LegendDispAttr.FontPitch=Variable!
        LegendDispAttr.BackColor=536870912
        LegendDispAttr.Format="[General]"
        LegendDispAttr.DisplayExpression="series"
        LegendDispAttr.AutoSize=true
        PieDispAttr.Weight=400
        PieDispAttr.FaceName="Arial"
        PieDispAttr.FontFamily=Swiss!
        PieDispAttr.FontPitch=Variable!
        PieDispAttr.BackColor=536870912
        PieDispAttr.Format="[General]"
        PieDispAttr.DisplayExpression="if(seriescount > 1,\
            series,string(percentofseries,\~"0.00%\~"))"
        PieDispAttr.AutoSize=true
    }
    set sect [TextSection new]
    $class initialOnDestroyResidue $sect
    expand_text $sect {
        destroy TitleDispAttr
        destroy LegendDispAttr
        destroy PieDispAttr
        destroy Series.DispAttr
        destroy Series.LabelDispAttr
        destroy Series
        destroy Category.DispAttr
        destroy Category.LabelDispAttr
        destroy Category
        destroy Values.DispAttr
        destroy Values.LabelDispAttr
        destroy Values
    }

    set class [PBBuiltinClass new groupbox \
        -kind ${PBClassKind::VSUserObject} -isControl 1]
    $instance setBuiltinClass groupbox $class
    $class setMandatoryProp Width [PBBuiltinProperty new Width int 494]
    $class setMandatoryProp Height [PBBuiltinProperty new Height int 361]
    $class setMandatoryProp Text [ \
        PBBuiltinProperty new Text string \"none\"]

    set class [PBBuiltinClass new hscrollbar \
        -kind ${PBClassKind::VSUserObject} -isControl 1 -hasCtorDtor 1]
    $instance setBuiltinClass hscrollbar $class
    $class setMandatoryProp Width [PBBuiltinProperty new Width int 293]
    $class setMandatoryProp Height [PBBuiltinProperty new Height int 65]

        set class [PBBuiltinClass new line \
            -kind ${PBClassKind::VSUserObject} -isControl 1]
        $instance setBuiltinClass line $class
        $class setMandatoryProp Width [\
            PBBuiltinProperty new Width int 494]
        $class setMandatoryProp Height [\
            PBBuiltinProperty new Height int 361]

    set class [PBBuiltinClass new listbox \
        -kind ${PBClassKind::VSUserObject} -isControl 1 -hasCtorDtor 1]
    $instance setBuiltinClass listbox $class
    $class setMandatoryProp Width [PBBuiltinProperty new Width int 494]
    $class setMandatoryProp Height [PBBuiltinProperty new Height int 361]

    set class [PBBuiltinClass new listview \
        -kind ${PBClassKind::VSUserObject} -isControl 1 -hasCtorDtor 1]
    $instance setBuiltinClass listview $class
    $class setMandatoryProp Width [PBBuiltinProperty new Width int 494]
    $class setMandatoryProp Height [PBBuiltinProperty new Height int 361]

    set class [PBBuiltinClass new mailsession \
        -kind ${PBClassKind::CSUserObject} -hasCtorDtor 1]
    $instance setBuiltinClass mailsession $class

    set class [PBBuiltinClass new menu \
        -kind ${PBClassKind::Menu} -isGrContainer 1]
    $instance setBuiltinClass menu $class
    # mandatory prop 'Text' is set in class PBMenuGen

    set class [PBBuiltinClass new menucascade \
        -kind ${PBClassKind::Menu} -isGrContainer 1]
    $instance setBuiltinClass menucascade $class
    # mandatory prop 'Text' is set in class PBMenuGen

    set class [PBBuiltinClass new message \
        -kind ${PBClassKind::CSUserObject} -hasCtorDtor 1]
    $instance setBuiltinClass message $class

    set class [PBBuiltinClass new multilineedit \
        -kind ${PBClassKind::VSUserObject} -isControl 1 -hasCtorDtor 1]
    $instance setBuiltinClass multilineedit $class
    $class setMandatoryProp Width [PBBuiltinProperty new Width int 494]
    $class setMandatoryProp Height [PBBuiltinProperty new Height int 361]

        set class [PBBuiltinClass new nonvisualobject \
            -kind ${PBClassKind::CCUserObject} -hasCtorDtor 1]
        $instance setBuiltinClass nonvisualobject $class

    set class [PBBuiltinClass new olecontrol \
        -kind ${PBClassKind::VSUserObject} -isControl 1 -hasCtorDtor 1]
    $instance setBuiltinClass olecontrol $class
    # mandatory props 'Width' & 'Height' set to 'a' default value
    $class setMandatoryProp Width [PBBuiltinProperty new Width int 494]
    $class setMandatoryProp Height [PBBuiltinProperty new Height int 361]

    set class [PBBuiltinClass new oleobject \
        -kind ${PBClassKind::CSUserObject} -hasCtorDtor 1]
    $instance setBuiltinClass oleobject $class

    set class [PBBuiltinClass new olestorage \
        -kind ${PBClassKind::CSUserObject} -hasCtorDtor 1]
    $instance setBuiltinClass olestorage $class

    set class [PBBuiltinClass new olestream \
        -kind ${PBClassKind::CSUserObject} -hasCtorDtor 1]
    $instance setBuiltinClass olestream $class

        set class [PBBuiltinClass new oval \
            -kind ${PBClassKind::VSUserObject} -isControl 1]
        $instance setBuiltinClass oval $class
        $class setMandatoryProp Width [\
            PBBuiltinProperty new Width int 165]
        $class setMandatoryProp Height [\
            PBBuiltinProperty new Height int 145]

    set class [PBBuiltinClass new picture \
        -kind ${PBClassKind::VSUserObject} -isControl 1 -hasCtorDtor 1]
    $instance setBuiltinClass picture $class
    $class setMandatoryProp Width [PBBuiltinProperty new Width int 165]
    $class setMandatoryProp Height [PBBuiltinProperty new Height int 145]

    set class [PBBuiltinClass new picturebutton \
        -kind ${PBClassKind::VSUserObject} -isControl 1 -hasCtorDtor 1]
    $instance setBuiltinClass picturebutton $class
    $class setMandatoryProp Width [PBBuiltinProperty new Width int 247]
    $class setMandatoryProp Height [PBBuiltinProperty new Height int 145]
    $class setMandatoryProp Text [ \
        PBBuiltinProperty new Text string \"none\"]

    set class [PBBuiltinClass new picturelistbox \
        -kind ${PBClassKind::VSUserObject} -isControl 1 -hasCtorDtor 1]
    $instance setBuiltinClass picturelistbox $class
    $class setMandatoryProp Width [PBBuiltinProperty new Width int 494]
    $class setMandatoryProp Height [PBBuiltinProperty new Height int 361]

    set class [PBBuiltinClass new pipeline \
        -kind ${PBClassKind::CSUserObject} -hasCtorDtor 1]
    $instance setBuiltinClass pipeline $class

    set class [PBBuiltinClass new radiobutton \
        -kind ${PBClassKind::VSUserObject} -isControl 1 -hasCtorDtor 1]
    $instance setBuiltinClass radiobutton $class
    $class setMandatoryProp Width [PBBuiltinProperty new Width int 247]
    $class setMandatoryProp Height [PBBuiltinProperty new Height int 77]
    $class setMandatoryProp Text [ \
        PBBuiltinProperty new Text string \"none\"]

        set class [PBBuiltinClass new rectangle \
            -kind ${PBClassKind::VSUserObject} -isControl 1]
        $instance setBuiltinClass rectangle $class
        $class setMandatoryProp Width [\
            PBBuiltinProperty new Width int 165]
        $class setMandatoryProp Height [\
            PBBuiltinProperty new Height int 145]

    set class [PBBuiltinClass new richtextedit \
        -kind ${PBClassKind::VSUserObject} -isControl 1 -hasCtorDtor 1]
    $instance setBuiltinClass richtextedit $class
    $class setMandatoryProp Width [PBBuiltinProperty new Width int 494]
    $class setMandatoryProp Height [PBBuiltinProperty new Height int 361]

        set class [PBBuiltinClass new roundrectangle \
            -kind ${PBClassKind::VSUserObject} -isControl 1]
        $instance setBuiltinClass roundrectangle $class
        $class setMandatoryProp Width [\
            PBBuiltinProperty new Width int 165]
        $class setMandatoryProp Height [\
            PBBuiltinProperty new Height int 145]

    set class [PBBuiltinClass new singlelineedit \
        -kind ${PBClassKind::VSUserObject} -isControl 1 -hasCtorDtor 1]
    $instance setBuiltinClass singlelineedit $class
    $class setMandatoryProp Width [PBBuiltinProperty new Width int 247]
    $class setMandatoryProp Height [PBBuiltinProperty new Height int 93]

    set class [PBBuiltinClass new statictext \
        -kind ${PBClassKind::VSUserObject} -isControl 1 -hasCtorDtor 1]
    $instance setBuiltinClass statictext $class
    $class setMandatoryProp Width [PBBuiltinProperty new Width int 247]
    $class setMandatoryProp Height [PBBuiltinProperty new Height int 77]
    $class setMandatoryProp Text [ \
        PBBuiltinProperty new Text string \"none\"]

    set class [PBBuiltinClass new structure \
        -kind ${PBClassKind::Structure}]
    $instance setBuiltinClass structure $class

    set class [PBBuiltinClass new tab \
        -kind ${PBClassKind::VSUserObject} -isControl 1 \
        -isGrContainer 1 -hasCtorDtor 1]
    $instance setBuiltinClass tab $class
    $class setMandatoryProp Width [PBBuiltinProperty new Width int 1153]
    $class setMandatoryProp Height [PBBuiltinProperty new Height int 865]

    set class [PBBuiltinClass new transaction \
        -kind ${PBClassKind::CSUserObject} -hasCtorDtor 1]
    $instance setBuiltinClass transaction $class

    set class [PBBuiltinClass new transport \
        -kind ${PBClassKind::CSUserObject} -hasCtorDtor 1]
    $instance setBuiltinClass transport $class

    set class [PBBuiltinClass new treeview \
        -kind ${PBClassKind::VSUserObject} -isControl 1 -hasCtorDtor 1]
    $instance setBuiltinClass treeview $class
    $class setMandatoryProp Width [PBBuiltinProperty new Width int 494]
    $class setMandatoryProp Height [PBBuiltinProperty new Height int 361]

        set class [PBBuiltinClass new userobject \
            -kind ${PBClassKind::VCUserObject} -isControl 1 \
            -isGrContainer 1 -hasCtorDtor 1]
        $instance setBuiltinClass userobject $class
        $class setMandatoryProp Width [\
            PBBuiltinProperty new Width int 2533]
        $class setMandatoryProp Height [\
            PBBuiltinProperty new Height int 1517]

    set class [PBBuiltinClass new vscrollbar \
        -kind ${PBClassKind::VSUserObject} -isControl 1 -hasCtorDtor 1]
    $instance setBuiltinClass vscrollbar $class
    $class setMandatoryProp Width [PBBuiltinProperty new Width int 74]
    $class setMandatoryProp Height [PBBuiltinProperty new Height int 257]

    set class [PBBuiltinClass new window \
        -kind ${PBClassKind::Window} -isGrContainer 1 -hasCtorDtor 1]
    $instance setBuiltinClass window $class
    $class setMandatoryProp Width [PBBuiltinProperty new Width int 2533]
    $class setMandatoryProp Height [PBBuiltinProperty new Height int 1517]

    return ${PBBuiltinInfo::instance}
}

# Do not delete this line -- regeneration end marker

method PBBuiltinInfo::getBuiltinClass {this name} {
    return [[$this builtinClass] set $name]
}

method PBBuiltinInfo::setBuiltinClass {this name newBuiltinClass} {
    [$this builtinClass] set $name $newBuiltinClass
}

method PBBuiltinInfo::removeBuiltinClass {this name} {
    [$this builtinClass] unset $name
}



#---------------------------------------------------------------------------
#      File:           @(#)pbdefiniti.tcl    /main/titanic/5


Class PBDefinitionGen : {GCObject} {
    constructor
    method destructor
    method generate
    method createPBDefinition
    method genFeatures
    method genDataAttrs
    method genOperations
    method genAssocAttrs
    method check
    method checkFeatures
    method checkLocal
    method checkDataAttrs
    method checkOperations
    method checkAssocAttrs
    attribute name
    attribute superNm
    attribute builtinSuperNm
    attribute isGlobalType
    attribute container
    attribute model
    attribute ooplClass
    attribute globalOoplClass
}

constructor PBDefinitionGen {class this i_name ooplClass} {
    set this [GCObject::constructor $class $this]
    $this name $i_name
    $this ooplClass $ooplClass
    # Start constructor user section

    $this builtinSuperNm [[$this ooplClass] getBuiltinSuperClassName]

    # End constructor user section
    return $this
}

method PBDefinitionGen::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

method PBDefinitionGen::generate {this} {
    set def [$this createPBDefinition]
    $this genFeatures $def
    return $def
}

method PBDefinitionGen::createPBDefinition {this} {
    set type [$this objType]
    set kind [string range $type 0 [expr {[string length $type] - 4}]]

    # pb internal lower cases class names
    set def [$kind new [string tolower [$this name]] [$this ooplClass] \
                 [string tolower [$this superNm]] \
                 [string tolower [$this builtinSuperNm]] \
        -isGlobalType [$this isGlobalType]]

    if [$this isGlobalType] {
        PBLibraryEntry new [$this model] $def
    } else {
        [$this container] addContainedClass $def
    }

    return $def
}

method PBDefinitionGen::genFeatures {this def} {
    if {[[$this ooplClass] isBuiltin] ||
        (![$this isGlobalType] && [[$this ooplClass] isGlobalType])} {
        # Only a type definition (a local one) is generated, without
        # variables, functions, user events and even scripts!
        return
    }
    $this genDataAttrs $def
    $this genOperations $def
    $this genAssocAttrs $def
}

method PBDefinitionGen::genDataAttrs {this def} {
    foreach attr [[$this ooplClass] dataAttrSet] {
        $attr generate $def
    }
}

method PBDefinitionGen::genOperations {this def} {
    foreach oper [[$this ooplClass] operationSet] {
        $oper generate $def
    }
    if {[[$this ooplClass] constructor] != ""} {
        [[$this ooplClass] constructor] generate $def
    }
}

method PBDefinitionGen::genAssocAttrs {this def} {
    foreach assoc [[$this ooplClass] genAssocAttrSet] {
        $assoc generate [$this globalOoplClass] $def
    }
}

method PBDefinitionGen::check {this} {
    set errornr 0
    incr errornr [$this checkLocal]
    return $errornr
}

method PBDefinitionGen::checkFeatures {this} {
    set errornr 0
    incr errornr [$this checkDataAttrs]
    incr errornr [$this checkOperations]
    incr errornr [$this checkAssocAttrs]
    return $errornr
}

method PBDefinitionGen::checkLocal {this} {
    set errornr 0
    # pb internal lower cases class names
    if { [$this name] != [string tolower [$this name]]} {
        m4_warning $W_DOWNCASECLASS [$this name]
    }
    incr errornr [$this checkFeatures]
    return $errornr
}

method PBDefinitionGen::checkDataAttrs {this} {
    set errornr 0
    foreach attr [[$this ooplClass] dataAttrSet] {
        incr errornr [$attr check $this]
    }
    return $errornr
}

method PBDefinitionGen::checkOperations {this} {
    set errornr 0
    foreach oper [[$this ooplClass] operationSet] {
        incr errornr [$oper check $this]
    }
    if {[[$this ooplClass] constructor] != ""} {
        incr errornr [[[$this ooplClass] constructor] check $this]
    }
    return $errornr
}

method PBDefinitionGen::checkAssocAttrs {this} {
    set errornr 0
    foreach assoc [[$this ooplClass] genAssocAttrSet] {
        incr errornr [$assoc check [$this globalOoplClass] $this]
    }
    return $errornr
}

# Do not delete this line -- regeneration end marker



#---------------------------------------------------------------------------
#      File:           @(#)pbgclassen.tcl    /main/titanic/3


Class PBGClassEnum : {PBGClass} {
    constructor
    method destructor
    method generate
    method checkLocal
    method checkEnum
}

constructor PBGClassEnum {class this name} {
    set this [PBGClass::constructor $class $this $name]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBGClassEnum::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

method PBGClassEnum::generate {this model} {
    m4_error $E_NOENUMS
}

method PBGClassEnum::checkLocal {this} {
    set errornr 0
    incr errornr [$this checkEnum]
    return $errornr
}

method PBGClassEnum::checkEnum {this} {
    set errornr 0
    m4_error $E_NOENUMS
    incr errornr 1
    return $errornr
}

# Do not delete this line -- regeneration end marker

if [isCommand CMClassEnum] {
    Class  PBGClassEnumD : {PBGClassEnum CMClassEnum} {
    }
} else {
    Class PBGClassEnumD : {PBGClassEnum OPClassEnum} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPClassEnum) PBGClassEnumD

selfPromoter OPClassEnum {this} {
    PBGClassEnumD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)pbgclassge.tcl    /main/titanic/3


Class PBGClassGenericTypeDef : {PBGClass} {
    constructor
    method destructor
    method generate
}

constructor PBGClassGenericTypeDef {class this name} {
    set this [PBGClass::constructor $class $this $name]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBGClassGenericTypeDef::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

method PBGClassGenericTypeDef::generate {this model} {
    $this PBGClass::generate $model
}

# Do not delete this line -- regeneration end marker

if [isCommand CMClassGenericTypeDef] {
    Class  PBGClassGenericTypeDefD : {PBGClassGenericTypeDef CMClassGenericTypeDef} {
    }
} else {
    Class PBGClassGenericTypeDefD : {PBGClassGenericTypeDef OPClassGenericTypeDef} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPClassGenericTypeDef) PBGClassGenericTypeDefD

selfPromoter OPClassGenericTypeDef {this} {
    PBGClassGenericTypeDefD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)pbgclasstd.tcl    /main/titanic/3


Class PBGClassTDef : {PBGClass} {
    constructor
    method destructor
    method generate
}

constructor PBGClassTDef {class this name} {
    set this [PBGClass::constructor $class $this $name]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBGClassTDef::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

method PBGClassTDef::generate {this model} {
    $this PBGClass::generate $model
}

# Do not delete this line -- regeneration end marker

if [isCommand CMClassTDef] {
    Class  PBGClassTDefD : {PBGClassTDef CMClassTDef} {
    }
} else {
    Class PBGClassTDefD : {PBGClassTDef OPClassTDef} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPClassTDef) PBGClassTDefD

selfPromoter OPClassTDef {this} {
    PBGClassTDefD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)pbglinkcla.tcl    /main/titanic/3


Class PBGLinkClass : {PBGClass} {
    constructor
    method destructor
    method generate
}

constructor PBGLinkClass {class this name} {
    set this [PBGClass::constructor $class $this $name]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBGLinkClass::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

method PBGLinkClass::generate {this model} {
    $this PBGClass::generate $model
}

# Do not delete this line -- regeneration end marker

if [isCommand CMLinkClass] {
    Class  PBGLinkClassD : {PBGLinkClass CMLinkClass} {
    }
} else {
    Class PBGLinkClassD : {PBGLinkClass OPLinkClass} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPLinkClass) PBGLinkClassD

selfPromoter OPLinkClass {this} {
    PBGLinkClassD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)pbgattribu.tcl    /main/titanic/3


Class PBGAttribute : {PBGFeature} {
    constructor
    method destructor
}

constructor PBGAttribute {class this name} {
    set this [PBGFeature::constructor $class $this $name]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBGAttribute::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

# Do not delete this line -- regeneration end marker

if [isCommand CMAttribute] {
    Class  PBGAttributeD : {PBGAttribute CMAttribute} {
    }
} else {
    Class PBGAttributeD : {PBGAttribute OPAttribute} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPAttribute) PBGAttributeD

selfPromoter OPAttribute {this} {
    PBGAttributeD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)pbgconstru.tcl    /main/titanic/3


Class PBGConstructor : {PBGFeature} {
    constructor
    method destructor
    method generate
}

constructor PBGConstructor {class this name} {
    set this [PBGFeature::constructor $class $this $name]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBGConstructor::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

method PBGConstructor::generate {this class} {
    return ""
}

# Do not delete this line -- regeneration end marker

if [isCommand CMConstructor] {
    Class  PBGConstructorD : {PBGConstructor CMConstructor} {
    }
} else {
    Class PBGConstructorD : {PBGConstructor OPConstructor} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPConstructor) PBGConstructorD

selfPromoter OPConstructor {this} {
    PBGConstructorD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)pbgoperati.tcl    /main/titanic/6


Class PBGOperation : {PBGFeature} {
    constructor
    method destructor
    method generate
    method generateFunction
    method generateAccess
    method generateEvent
    method isEvent
    method isUserEvent
}

constructor PBGOperation {class this name} {
    set this [PBGFeature::constructor $class $this $name]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBGOperation::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

method PBGOperation::generate {this class} {
    if [$this isEvent] {
        set oper [$this generateEvent $class]
    } else {
        set oper [$this generateFunction $class]
    }

    return $oper
}

method PBGOperation::generateFunction {this class} {
    set type [[$this ooplType] generate]
    set access [$this generateAccess]
    set func [PBFunction new [$this getName] $type $access]

    foreach param [$this parameterSet] {
        $param generate $func
    }

    $class addObjectFunction $func

    return $func
}

method PBGOperation::generateAccess {this} {
    set access [string tolower [$this getPropertyValue "method_access"]]
    if {$access == "" } {
        set access "public"
    }
    return [PBAccess new $access]
}

method PBGOperation::generateEvent {this class} {
    set type [[$this ooplType] generate]
    set name [$this getName]
    if {$name == "constructor"} {
        set event [PBConstructor new $name $type]
    } elseif {$name == "destructor"} {
        set event [PBDestructor new $name $type]
    } else {
        set event [PBEvent new $name $type]
    }

    set firstParam 1
    foreach param [$this parameterSet] {
        # special case when type of first parameter is "eventid";
        # in this case, prevent mapping of standard type "eventid"
        # onto language type "string"
        if $firstParam {
            set firstParam 0
            set pbParam [$param generate $event]
            if {[[$param ooplType] getName] == "eventid"} {
                [$pbParam type] name "eventid"
                break
            }
        } else {
            $param generate $event
        }
    }

    if {[$this isUserEvent]} {
        $class addUserEvent $event
    } else {
        $class addScript $event
    }

    return $event
}

method PBGOperation::isEvent {this} {
    if {[$this getPropertyValue is_event] == "1"} {
        return 1
    }
    return 0
}

method PBGOperation::isUserEvent {this} {
    set superClass [[$this ooplClass] getSuperClass]
    while {$superClass != ""} {
        if [$superClass hasEvent [$this getName]] {
            return 0
        }
        set superClass [$superClass getSuperClass]
    }
    return 1
}

# Do not delete this line -- regeneration end marker

if [isCommand CMOperation] {
    Class  PBGOperationD : {PBGOperation CMOperation} {
    }
} else {
    Class PBGOperationD : {PBGOperation OPOperation} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPOperation) PBGOperationD

selfPromoter OPOperation {this} {
    PBGOperationD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)pbgctorpar.tcl    /main/titanic/3


Class PBGCtorParameter : {PBGParameter} {
    constructor
    method destructor
    method generate
}

constructor PBGCtorParameter {class this name} {
    set this [PBGParameter::constructor $class $this $name]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBGCtorParameter::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

method PBGCtorParameter::generate {this oper} {
    # !! Implement this function !!
}

# Do not delete this line -- regeneration end marker

if [isCommand CMCtorParameter] {
    Class  PBGCtorParameterD : {PBGCtorParameter CMCtorParameter} {
    }
} else {
    Class PBGCtorParameterD : {PBGCtorParameter OPCtorParameter} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPCtorParameter) PBGCtorParameterD

selfPromoter OPCtorParameter {this} {
    PBGCtorParameterD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)pbgoperpar.tcl    /main/titanic/4


Class PBGOperParameter : {PBGParameter} {
    constructor
    method destructor
    method generate
    method generateModifier
}

constructor PBGOperParameter {class this name} {
    set this [PBGParameter::constructor $class $this $name]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBGOperParameter::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

method PBGOperParameter::generate {this oper} {
    set type [[$this ooplType] generate]
    set modifier [$this generateModifier]
    set param [PBParameter new [$this getName] $type $modifier \
        -arrayDesc [[$this ooplType] arrayDesc]]
    $oper addParameter $param
    return $param
}

method PBGOperParameter::generateModifier {this} {
    set modifier [$this getPropertyValue "pass_by"]
    if {$modifier == "Reference"} {
        set modifier "ref"
    } elseif {$modifier == "ReadOnly"} {
        set modifier "readonly"
    } else {
        set modifier ""
    }
    return [PBModifier new $modifier]
}

# Do not delete this line -- regeneration end marker

if [isCommand CMOperParameter] {
    Class  PBGOperParameterD : {PBGOperParameter CMOperParameter} {
    }
} else {
    Class PBGOperParameterD : {PBGOperParameter OPOperParameter} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPOperParameter) PBGOperParameterD

selfPromoter OPOperParameter {this} {
    PBGOperParameterD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)pbgbasetyp.tcl    /main/titanic/4


Class PBGBaseType : {PBGType} {
    constructor
    method destructor
    method generate
}

constructor PBGBaseType {class this name} {
    set this [PBGType::constructor $class $this $name]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBGBaseType::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

method PBGBaseType::generate {this} {
    set type [$this getType3GL]

    set arrayDesc ""
    regexp {\[.*\]$} $type arrayDesc
    $this arrayDesc $arrayDesc

    regsub {\[.*\]$} $type "" type
    return [PBType new $type]
}

# Do not delete this line -- regeneration end marker

if [isCommand CMBaseType] {
    Class  PBGBaseTypeD : {PBGBaseType CMBaseType} {
    }
} else {
    Class PBGBaseTypeD : {PBGBaseType OPBaseType} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPBaseType) PBGBaseTypeD

selfPromoter OPBaseType {this} {
    PBGBaseTypeD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)pbgclassty.tcl    /main/titanic/4


Class PBGClassType : {PBGType} {
    constructor
    method destructor
    method generate
}

constructor PBGClassType {class this name} {
    set this [PBGType::constructor $class $this $name]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBGClassType::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

method PBGClassType::generate {this} {
    # pb internal lower cases class names
    return [PBType new [string tolower [$this getName]]]
}

# Do not delete this line -- regeneration end marker

if [isCommand CMClassType] {
    Class  PBGClassTypeD : {PBGClassType CMClassType} {
    }
} else {
    Class PBGClassTypeD : {PBGClassType OPClassType} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPClassType) PBGClassTypeD

selfPromoter OPClassType {this} {
    PBGClassTypeD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)pbgenumtyp.tcl    /main/titanic/3


Class PBGEnumType : {PBGType} {
    constructor
    method destructor
    method generate
}

constructor PBGEnumType {class this name} {
    set this [PBGType::constructor $class $this $name]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBGEnumType::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

method PBGEnumType::generate {this} {
    return [PBType new [$this getName]]
}

# Do not delete this line -- regeneration end marker

if [isCommand CMEnumType] {
    Class  PBGEnumTypeD : {PBGEnumType CMEnumType} {
    }
} else {
    Class PBGEnumTypeD : {PBGEnumType OPEnumType} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPEnumType) PBGEnumTypeD

selfPromoter OPEnumType {this} {
    PBGEnumTypeD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)pbgtypedef.tcl    /main/titanic/3


Class PBGTypeDefType : {PBGType} {
    constructor
    method destructor
    method generate
}

constructor PBGTypeDefType {class this name} {
    set this [PBGType::constructor $class $this $name]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBGTypeDefType::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

method PBGTypeDefType::generate {this} {
    return [PBType new [$this getName]]
}

# Do not delete this line -- regeneration end marker

if [isCommand CMTypeDefType] {
    Class  PBGTypeDefTypeD : {PBGTypeDefType CMTypeDefType} {
    }
} else {
    Class PBGTypeDefTypeD : {PBGTypeDefType OPTypeDefType} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPTypeDefType) PBGTypeDefTypeD

selfPromoter OPTypeDefType {this} {
    PBGTypeDefTypeD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)pbclasscus.tcl    /main/titanic/1


Class PBClassCustomUserObjectGen : {PBDefinitionGen} {
    constructor
    method destructor
    method createPBDefinition
}

constructor PBClassCustomUserObjectGen {class this i_name ooplClass} {
    set this [PBDefinitionGen::constructor $class $this $i_name $ooplClass]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBClassCustomUserObjectGen::destructor {this} {
    # Start destructor user section
    # End destructor user section
    $this PBDefinitionGen::destructor
}

method PBClassCustomUserObjectGen::createPBDefinition {this} {
    set def [$this PBDefinitionGen::createPBDefinition]
    $def isAutoInstantiate [[$this ooplClass] isAutoInstantiate]
    return $def
}

# Do not delete this line -- regeneration end marker



#---------------------------------------------------------------------------
#      File:           @(#)pbclasssta.tcl    /main/titanic/1


Class PBClassStandardUserObjectGen : {PBDefinitionGen} {
    constructor
    method destructor
}

constructor PBClassStandardUserObjectGen {class this i_name ooplClass} {
    set this [PBDefinitionGen::constructor $class $this $i_name $ooplClass]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBClassStandardUserObjectGen::destructor {this} {
    # Start destructor user section
    # End destructor user section
    $this PBDefinitionGen::destructor
}

# Do not delete this line -- regeneration end marker



#---------------------------------------------------------------------------
#      File:           @(#)pbmenugen.tcl    /main/titanic/5


Class PBMenuGen : {PBDefinitionGen} {
    constructor
    method destructor
    method createPBDefinition
    method genAssocAttrs
    method checkAssocAttrs
}

constructor PBMenuGen {class this i_name ooplClass} {
    set this [PBDefinitionGen::constructor $class $this $i_name $ooplClass]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBMenuGen::destructor {this} {
    # Start destructor user section
    # End destructor user section
    $this PBDefinitionGen::destructor
}

method PBMenuGen::createPBDefinition {this} {
    set def [$this PBDefinitionGen::createPBDefinition]

    # set default for (mandatory) builtin property 'Text'
    $def setBuiltinProperty Text [PBBuiltinProperty new Text string \
        \"[$this name]\" -where ${PBBuiltinProperty::InOnCreate}]

    return $def
}

method PBMenuGen::genAssocAttrs {this def} {
    foreach assoc [[$this ooplClass] genAssocAttrSet] {
        set oppClass [$assoc getOppositeClass]
        if {$oppClass == ""} {
            # error is already given
            continue
        }
        if {[$oppClass getPBClassKind] == ${PBClassKind::Window}} {
            # waraning is already given: $W_IGNMENUWINAGGR
            continue
        }
        $assoc generate [$this globalOoplClass] $def
    }
}

method PBMenuGen::checkAssocAttrs {this} {
    set warningnr 0
    set errornr 0
    foreach assoc [[$this ooplClass] genAssocAttrSet] {
        set tmpError [$assoc checkOppositeClass $this]
        incr errornr $tmpError
        if {$tmpError == 0 } {
            set oppClass [$assoc getOppositeClass]
            if {$oppClass == ""} {
                # error is already given
                continue
            }
            if {[$oppClass getPBClassKind] == ${PBClassKind::Window}} {
                m4_warning $W_IGNMENUWINAGGR [$assoc getName] \
                    [$this name] [$oppClass getName]
                incr warningnr 1
                continue
            }
        incr errornr [$assoc check [$this globalOoplClass] $this]
        }
    }
    return $errornr
}

# Do not delete this line -- regeneration end marker



#---------------------------------------------------------------------------
#      File:           @(#)pbstructur.tcl    /main/titanic/4


Class PBStructureGen : {PBDefinitionGen} {
    constructor
    method destructor
    method createPBDefinition
    method genFeatures
    method checkFeatures
}

constructor PBStructureGen {class this i_name ooplClass} {
    set this [PBDefinitionGen::constructor $class $this $i_name $ooplClass]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBStructureGen::destructor {this} {
    # Start destructor user section
    # End destructor user section
    $this PBDefinitionGen::destructor
}

method PBStructureGen::createPBDefinition {this} {
    set def [PBStructure new [$this name] [$this ooplClass] \
        -isGlobalType [$this isGlobalType]]

    if [$this isGlobalType] {
        PBLibraryEntry new [$this model] $def
    } else {
        [$this container] addObjectStructure $def
    }

    return $def
}

method PBStructureGen::genFeatures {this def} {
    foreach attr [[$this ooplClass] dataAttrSet] {
        set type [[$attr ooplType] generate]
        set field [PBNameType new [$attr getName] $type \
                       -arrayDesc [[$attr ooplType] arrayDesc]]
        $def addField $field
    }
}

method PBStructureGen::checkFeatures {this} {
    set errornr 0
    foreach attr [[$this ooplClass] dataAttrSet] {
        incr errornr 0
    }
    return $errornr
}

# Do not delete this line -- regeneration end marker



#---------------------------------------------------------------------------
#      File:           @(#)pbvisualcu.tcl    /main/titanic/1


Class PBVisualCustomUserObjectGen : {PBDefinitionGen} {
    constructor
    method destructor
    method createPBDefinition
}

constructor PBVisualCustomUserObjectGen {class this i_name ooplClass} {
    set this [PBDefinitionGen::constructor $class $this $i_name $ooplClass]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBVisualCustomUserObjectGen::destructor {this} {
    # Start destructor user section
    # End destructor user section
    $this PBDefinitionGen::destructor
}

method PBVisualCustomUserObjectGen::createPBDefinition {this} {
    set def [$this PBDefinitionGen::createPBDefinition]
    $def isAutoInstantiate [[$this ooplClass] isAutoInstantiate]
    return $def
}

# Do not delete this line -- regeneration end marker



#---------------------------------------------------------------------------
#      File:           @(#)pbvisualst.tcl    /main/titanic/1


Class PBVisualStandardUserObjectGen : {PBDefinitionGen} {
    constructor
    method destructor
}

constructor PBVisualStandardUserObjectGen {class this i_name ooplClass} {
    set this [PBDefinitionGen::constructor $class $this $i_name $ooplClass]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBVisualStandardUserObjectGen::destructor {this} {
    # Start destructor user section
    # End destructor user section
    $this PBDefinitionGen::destructor
}

# Do not delete this line -- regeneration end marker



#---------------------------------------------------------------------------
#      File:           @(#)pbwindowge.tcl    /main/titanic/6


Class PBWindowGen : {PBDefinitionGen} {
    constructor
    method destructor
    method createPBDefinition
    method genAssocAttrs
    method checkAssocAttrs
}

constructor PBWindowGen {class this i_name ooplClass} {
    set this [PBDefinitionGen::constructor $class $this $i_name $ooplClass]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBWindowGen::destructor {this} {
    # Start destructor user section
    # End destructor user section
    $this PBDefinitionGen::destructor
}

method PBWindowGen::createPBDefinition {this} {
    set def [$this PBDefinitionGen::createPBDefinition]

    set windowType [[$this ooplClass] getWindowType]
    if {$windowType == "MDI" || $windowType == "MDIHelp"} {
        set mdiclient [PBVisual new "mdi_1" "" "mdiclient" "mdiclient" \
            -isGlobalType 0]
        $def addContainedClass $mdiclient
    }
    set windowType "[string tolower $windowType]!"
    $def setBuiltinProperty WindowType [PBBuiltinProperty \
        new WindowType WindowType $windowType \
        -where ${PBBuiltinProperty::InTypeDef}]

    return $def
}

method PBWindowGen::genAssocAttrs {this def} {
    foreach assoc [[$this ooplClass] genAssocAttrSet] {
        set oppClass [$assoc getOppositeClass]
        if {$oppClass == ""} {
            # error is already given
            continue
        }
        if {[$oppClass getPBClassKind] == ${PBClassKind::Menu}} {
            set menuName [$oppClass getName]
            $def setBuiltinProperty MenuName [PBBuiltinProperty \
                new MenuName string \"${menuName}\" \
                -where ${PBBuiltinProperty::InTypeDef}]
            $def menuName $menuName
            continue
        }
        $assoc generate [$this globalOoplClass] $def
    }
}

method PBWindowGen::checkAssocAttrs {this} {
    set errornr 0
    foreach assoc [[$this ooplClass] genAssocAttrSet] {
        set oppClass [$assoc getOppositeClass]
        if {$oppClass == ""} {
            # error is already given
            continue
        }
        if {[$oppClass getPBClassKind] == ${PBClassKind::Menu}} {
            continue
        }
        incr errornr [$assoc check [$this globalOoplClass] $this]
    }
    return $errornr

}

# Do not delete this line -- regeneration end marker



#---------------------------------------------------------------------------
#      File:           @(#)pbgdataatt.tcl    /main/titanic/6


Class PBGDataAttr : {PBGAttribute} {
    constructor
    method destructor
    method generate
    method generateAccess
    method isConstant
    method isShared
    method checkLocal
    method checkConst
}

constructor PBGDataAttr {class this name} {
    set this [PBGAttribute::constructor $class $this $name]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBGDataAttr::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

method PBGDataAttr::generate {this class} {
    set type [[$this ooplType] generate]
    set access [$this generateAccess]
    set attr [PBVariable new [$this getName] $type $access \
        -arrayDesc [[$this ooplType] arrayDesc]]
    set defVal [$this getInitialValue]
    if {$defVal != ""} {
        $attr defaultValue $defVal
    }
    if {[$this isConstant]} {
        if {$defVal != ""} {
            $attr isConstant 1
        } else {
            # warning W_CONST_IGNORED already given
        }
    }
    $attr isShared [$this isShared]
    if {[$this isShared]} {
        $class addSharedVar $attr
    } else {
        $class addInstanceVar $attr
    }
    return $attr
}

method PBGDataAttr::generateAccess {this} {
    set accessList [$this getPropertyValue "attrib_access"]
    switch -exact -- $accessList {
        Public-Public
            {return [PBVarAccess new "" "" ""]}
        Public-Protected
            {return [PBVarAccess new "" "" "protectedwrite"]}
        Public-Private
            {return [PBVarAccess new "" "" "privatewrite"]}
        Protected-Public -
        Protected-Protected
            {return [PBVarAccess new "protected" "" ""]}
        Protected-Private
            {return [PBVarAccess new "protected" "" "privatewrite"]}
        Private-Public -
        Private-Protected -
        Private-Private
            {return [PBVarAccess new "private" "" ""]}
        default
            {return [PBVarAccess new "" "" ""]}
    }
}

method PBGDataAttr::isConstant {this} {
    if {[$this getPropertyValue is_const_attrib] == "1"} {
        return 1
    }
    return 0
}

method PBGDataAttr::isShared {this} {
    return [$this isClassFeature]
}

method PBGDataAttr::checkLocal {this class} {
    set errornr 0
    set warningnr 0
    incr errornr [$this PBGAttribute::checkLocal $class]
    incr warningnr [$this checkConst $class]
    return $errornr
}

method PBGDataAttr::checkConst {this class} {
    set warningnr 0
    set defVal [$this getInitialValue]
    if {[$this isConstant]} {
        if {$defVal != ""} {
        } else {
            m4_warning $W_CONST_IGNORED [$this getName] \
                [$class name]
            incr warningnr 1
        }
    }
    return $warningnr
}

# Do not delete this line -- regeneration end marker

if [isCommand CMDataAttr] {
    Class  PBGDataAttrD : {PBGDataAttr CMDataAttr} {
    }
} else {
    Class PBGDataAttrD : {PBGDataAttr OPDataAttr} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPDataAttr) PBGDataAttrD

selfPromoter OPDataAttr {this} {
    PBGDataAttrD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)pbggenasso.tcl    /main/titanic/17


Class PBGGenAssocAttr : {PBGAttribute} {
    constructor
    method destructor
    method promoter
    method getThisClass
    method getOppositeClass
    method isValidAssociation
    method genAddAccessor
    method genGetAccessor
    method genGetManyAccessor
    method genRemoveOneAccessor
    method genRemoveAccessor
    method genSetAccessor
    method genAssocVariable
    method getAssocIdentifier
    method getAssocVariable
    method getAccessorAccess
    method genCtor
    method genDtor
    method extendAssoc
    method reduceAssoc
    method setAssoc
    method check
    method checkLocal
    method checkOppositeClass
    method checkValidAssociation
    method checkAssoc
    method checkAssocClass
    attribute oppClass
}

constructor PBGGenAssocAttr {class this name} {
    set this [PBGAttribute::constructor $class $this $name]
    $this oppClass "_uninitialized_"
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBGGenAssocAttr::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

method PBGGenAssocAttr::promoter {this} {
    $this oppClass "_uninitialized_"
}

method PBGGenAssocAttr::getThisClass {this} {
    return [$this ooplClass]
}

method PBGGenAssocAttr::getOppositeClass {this} {
    if {[$this oppClass] != "_uninitialized_"} {
        return [$this oppClass]
    }

    set type [$this ooplType]
    set ooplClass ""
    if [$type isA OPBaseType] {
#        m4_error $E_ASSWITHBASETYPE [$this getName] \
#            [[$this getThisClass] getName] [$type getName]
    } elseif [$type isA OPEnumType] {
#        m4_error $E_ASSWITHENUMTYPE [$this getName] \
#            [[$this getThisClass] getName] [$type getName]
    } else {
        set ooplClass [$type ooplClass]
        if {$ooplClass == ""} {
#            m4_error $E_ASSCLASSNONAME [$this getName] \
#                [[$this getThisClass] getName]
        }
    }
    $this oppClass $ooplClass
    return $ooplClass
}

method PBGGenAssocAttr::isValidAssociation {this} {
    set errornr 0
    set thisClass [$this getThisClass]
    set oppClass [$this getOppositeClass]
    if {$oppClass == ""} {
        incr errornr 1
    } elseif {![$thisClass isGlobalType] || ![$oppClass isGlobalType]} {
        set opposite [$this opposite]
        if {[$thisClass isGlobalType] && \
            ($opposite == "") && \
            [$thisClass getPBClassKind] == ${PBClassKind::Window}} {
            #assoc with window
        } else {
            incr errornr 1
        }
    } elseif {[$oppClass getPBClassKind] == ${PBClassKind::Structure}} {
        incr errornr 1
    } elseif {[$thisClass getBuiltinSuperClass] == ""} {
        incr errornr 1
    } else {
        set classInfo [[PBBuiltinInfo::global] getBuiltinClass \
                           [$thisClass getBuiltinSuperClassName]]
        if ![$classInfo hasCtorDtor] {
            incr errornr 1
        } elseif {[$oppClass getBuiltinSuperClass] == ""} {
        # error is already given
            incr errornr 1
        } else {
            set oppClassInfo [[PBBuiltinInfo::global] getBuiltinClass \
                                  [$oppClass getBuiltinSuperClassName]]
            if {[$this opposite] != "" && ![$oppClassInfo hasCtorDtor]} {
                incr errornr 1
            }
        }
    }
    if {$errornr == 0} {
        return 1
    } else {
        return 0
    }
}

method PBGGenAssocAttr::genAddAccessor {this class} {
    set opposite [$this opposite]
    if {$opposite == ""} {
        set accessStr [$this getAccessorAccess w]
    } else {
        set accessStr "public"
    }
    if {$accessStr == "none"} {
        return
    }

    set ident [$this getAssocIdentifier]

    set name "add[cap $ident]"
    set type [PBType new ""]
    set access [PBAccess new $accessStr]

    set accessor [PBFunction new $name $type $access]
    $class addObjectFunction $accessor

    if [$this isQualified] {
        set qualifier [$this qualifier]
    } elseif {$opposite != "" && [$opposite isQualified]} {
        set qualifier [$opposite qualifier]
    } else {
        set qualifier ""
    }
    if {$qualifier != ""} {
        set qualId [$qualifier getName]
        set qualTypeName [[$qualifier ooplType] getName]
        set type [PBType new $qualTypeName]
        set modifier [PBModifier new ""]
        set param [PBParameter new $qualId $type $modifier]
        $accessor addParameter $param
    }

    set paramId "new[cap $ident]"
    set paramType [[$this ooplType] generate]
    set modifier [PBModifier new ""]
    set param [PBParameter new $paramId $paramType $modifier]
    $accessor addParameter $param

    # Generate body
    #
    set sect [TextSection new]
    $accessor body $sect
    $sect append "${PBCookie::associationAccessorMethod}\n"
    $sect append "if isNull($paramId) then\n"
    $sect indent +
    $sect append "return\n"
    $sect indent -
    $sect append "end if\n"

    if {$opposite != ""} {
        if {[$opposite getMultiplicity] == "one" &&
                ![$opposite isQualified] && ![$this isQualified]} {
            $sect append [$opposite setAssoc $paramId]
        }
        $sect append [$opposite extendAssoc $paramId]
    }

    if {[$this isQualified]} {
        set varName [$this getAssocVariable]
        $sect append "classset theSet\n"
        $sect append "theSet = $varName.get($qualId)\n"
        $sect append "if isNull(theSet) then\n"
        $sect indent +
        $sect append "theSet = create classset\n"
        $sect append "$varName.set($qualId, theSet)\n"
        $sect indent -
        $sect append "end if\n"
        $sect append "theSet.add($paramId)\n"
    } else {
        $sect append [$this extendAssoc "" $paramId]
    }
}

method PBGGenAssocAttr::genGetAccessor {this class} {
    set opposite [$this opposite]
    if {$opposite == ""} {
        set accessStr [$this getAccessorAccess r]
    } else {
        set accessStr "public"
    }
    if {$accessStr == "none"} {
                return
        }

    set varName [$this getAssocVariable]
    set name "get[cap $varName]"
    set type [[$this ooplType] generate]
        set access [PBAccess new $accessStr]

    set accessor [PBFunction new $name $type $access]
    $class addObjectFunction $accessor

    # Generate body
    #
    set sect [TextSection new]
    $accessor body $sect
    $sect append "${PBCookie::associationAccessorMethod}\n"
    $sect append "return $varName\n"
}

method PBGGenAssocAttr::genGetManyAccessor {this class} {
    set opposite [$this opposite]
    if {$opposite == ""} {
        set accessStr [$this getAccessorAccess r]
    } else {
        set accessStr "public"
    }
    if {$accessStr == "none"} {
        return
    }

    set varName [$this getAssocVariable]
    set name "get[cap $varName]"
    set type [PBType new "classset"]
    set access [PBAccess new $accessStr]

    set accessor [PBFunction new $name $type $access]
    $class addObjectFunction $accessor

    # Generate body
    #
    set sect [TextSection new]
    $accessor body $sect
    $sect append "${PBCookie::associationAccessorMethod}\n"
    $sect append "return $varName\n"
}

method PBGGenAssocAttr::genRemoveOneAccessor {this class} {
    ## when mandatory not generate method.
    if {[$this isMandatory]} {
        return
    }

    set opposite [$this opposite]
    if {$opposite == ""} {
        set accessStr [$this getAccessorAccess w]
    } else {
        set accessStr "public"
    }
    if {$accessStr == "none"} {
        return
    }

    set ident [$this getAssocIdentifier]

    set name "remove[cap $ident]"
    set type [PBType new ""]
    set access [PBAccess new $accessStr]

    set accessor [PBFunction new $name $type $access]
    $class addObjectFunction $accessor

    if {$opposite != "" && [$opposite isQualified]} {
        set qualifier [$opposite qualifier]
        set qualId [$qualifier getName]
        set qualTypeName [[$qualifier ooplType] getName]
        set type [PBType new $qualTypeName]
        set modifier [PBModifier new ""]
        set param [PBParameter new $qualId $type $modifier]
        $accessor addParameter $param
    }

    # Generate body
    #
    set sect [TextSection new]
    $accessor body $sect
    $sect append "${PBCookie::associationAccessorMethod}\n"
    if {$opposite != ""} {
        $sect append "if not isNull($ident) then\n"
        $sect indent +
        $sect append [$opposite reduceAssoc $ident]
        $sect indent -
        $sect append "end if\n"
    }
    $sect append "setNull($ident)\n"
}

method PBGGenAssocAttr::genRemoveAccessor {this class} {
    set opposite [$this opposite]
    if {$opposite == ""} {
        set accessStr [$this getAccessorAccess w]
    } else {
        set accessStr "public"
    }
    if {$accessStr == "none"} {
        return
    }

    set ident [$this getAssocIdentifier]

    set name "remove[cap $ident]"
    set type [PBType new ""]
    set access [PBAccess new $accessStr]

    set accessor [PBFunction new $name $type $access]
    $class addObjectFunction $accessor

    if {$opposite != "" && [$opposite isQualified]} {
        set qualifier [$opposite qualifier]
        set qualId [$qualifier getName]
        set qualTypeName [[$qualifier ooplType] getName]
        set type [PBType new $qualTypeName]
        set modifier [PBModifier new ""]
        set param [PBParameter new $qualId $type $modifier]
        $accessor addParameter $param
    }

    set paramId "old[cap $ident]"
    set paramType [[$this ooplType] generate]
    set modifier [PBModifier new ""]
    set param [PBParameter new $paramId $paramType $modifier]
    $accessor addParameter $param

    # Generate body
    #
    set sect [TextSection new]
    $accessor body $sect
    $sect append "${PBCookie::associationAccessorMethod}\n"
    $sect append "if isNull($paramId) then\n"
    $sect indent +
    $sect append "return\n"
    $sect indent -
    $sect append "end if\n"

    if {$opposite != ""} {
        $sect append [$opposite reduceAssoc $paramId]
    }
    $sect append [$this reduceAssoc "" $paramId]
}

method PBGGenAssocAttr::genSetAccessor {this class} {
    set opposite [$this opposite]
    if {$opposite == ""} {
        set accessStr [$this getAccessorAccess w]
    } else {
        set accessStr "public"
    }
    if {$accessStr == "none"} {
        return
    }

    set ident [$this getAssocIdentifier]

    set name "set[cap $ident]"
    set type [PBType new ""]
    set access [PBAccess new $accessStr]

    set accessor [PBFunction new $name $type $access]
    $class addObjectFunction $accessor

    if {$opposite != "" && [$opposite isQualified]} {
        set qualifier [$opposite qualifier]
        set qualId [$qualifier getName]
        set qualTypeName [[$qualifier ooplType] getName]
        set type [PBType new $qualTypeName]
        set modifier [PBModifier new ""]
        set param [PBParameter new $qualId $type $modifier]
        $accessor addParameter $param
    }

    set paramId "new[cap $ident]"
    set paramType [[$this ooplType] generate]
    set modifier [PBModifier new ""]
    set param [PBParameter new $paramId $paramType $modifier]
    $accessor addParameter $param

    # Generate body
    #
    set sect [TextSection new]
    $accessor body $sect
    $sect append "${PBCookie::associationAccessorMethod}\n"
    ## when mandatory no empty values allowed.
    if {[$this isMandatory]} {
        $sect append "if isNull($paramId) then\n"
        $sect indent +
        $sect append "return\n"
        $sect indent -
        $sect append "end if\n"
    }
    if {$opposite != ""} {
        if {[$opposite isQualified]} {
            $sect append "if not isNull($paramId) then\n"
            $sect indent +
            $sect append [$opposite extendAssoc $paramId]
            $sect indent -
            $sect append "end if\n"
        } else {
            $sect append "if not isNull($ident) then\n"
            $sect indent +
            $sect append [$opposite reduceAssoc $ident]
            $sect indent -
            $sect append "end if\n"

            if {[$opposite getMultiplicity] == "one"} {
                $sect append "if not isNull($paramId) then\n"
                $sect indent +
                $sect append [$opposite setAssoc $paramId]
                $sect append [$opposite extendAssoc $paramId]
                $sect indent -
                $sect append "end if\n"
            } else {
                $sect append "if not isNull($paramId) then\n"
                $sect indent +
                $sect append [$opposite extendAssoc $paramId]
                $sect indent -
                $sect append "end if\n"
            }
        }
    }
    $sect append "$ident = $paramId\n"
}

method PBGGenAssocAttr::genAssocVariable {this class} {
    if [$this isQualified] {
        set type [PBType new "classdict"]
    } elseif {[$this getMultiplicity] == "many"} {
        set type [PBType new "classset"]
    } else {
        set type [[$this ooplType] generate]
    }

    if {[$this opposite] != ""} {
        set access [PBVarAccess new "public" "" ""]
    } else {
        set access [PBVarAccess new "private" "" ""]
    }

        set name [$this getAssocVariable]
        set var [PBVariable new $name $type $access]
        $class addAssocInstanceVar $var
}

method PBGGenAssocAttr::getAssocIdentifier {this} {
    if {[$this isLinkAttr]} {
        return [uncap [[$this ooplType] getName]Of[cap [$this getName]]]
    }
    return [$this getName]
}

method PBGGenAssocAttr::getAssocVariable {this} {
    set name [$this getAssocIdentifier]
    if {[$this isQualified]} {
        set name "${name}Dict"
    } elseif {[$this getMultiplicity] == "many"} {
        set name "${name}Set"
    }
    return [uncap $name]
}

method PBGGenAssocAttr::getAccessorAccess {this mode} {
    set accessList [split [$this getPropertyValue assoc_access] -]
    if {$mode == "r"} {
        set accessStr [lindex $accessList 0]
    } else {
        set accessStr [lindex $accessList 1]
    }
    if {$accessStr == ""} {
        set accessStr "public"
    }
    return [string tolower $accessStr]
}

method PBGGenAssocAttr::genCtor {this class} {
    # for assoc with windows
    set thisClass [$this getThisClass]
    if {[$thisClass getPBClassKind] == ${PBClassKind::Window}} {
        set closeEvent [$class findEvent "open"]
        if {$closeEvent == ""} {
            set type [PBType new "long"]
            set closeEvent [PBEvent new "open" $type]
            $class addScript $closeEvent
        }
    }

    set ctor [$class findEvent "constructor"]
    if {$ctor == ""} {
        set ctor [PBConstructor new "constructor" [PBType new ""]]
        $class addScript $ctor
    }
    if {[$ctor preBody] == ""} {
        $ctor preBody [TextSection new]
    }
    set varName [$this getAssocVariable]
    if {[$this isQualified]} {
        set initStr "$varName = create classdict"
    } elseif {[$this getMultiplicity] == "many"} {
        set initStr "$varName = create classset"
    } else {
        set initStr "setNull($varName)"
    }
    [$ctor preBody] append "${initStr}\n"
}

method PBGGenAssocAttr::genDtor {this class} {
    # for assoc with windows
    set thisClass [$this getThisClass]
    if {[$thisClass getPBClassKind] == ${PBClassKind::Window}} {
        set closeEvent [$class findEvent "close"]
        if {$closeEvent == ""} {
            set type [PBType new "long"]
            set closeEvent [PBEvent new "close" $type]
            $class addScript $closeEvent
        }
    }

    set dtor [$class findEvent "destructor"]
    if {$dtor == ""} {
        set dtor [PBDestructor new "destructor" [PBType new ""]]
        $class addScript $dtor
    }
    if {[$dtor postBody] == ""} {
        $dtor postBody [TextSection new]
    }
    set varName [$this getAssocVariable]
    ## set opposites to Null (if applicable)
    set opposite [$this opposite]
    if {$opposite != ""} {
        set accessStr [$this getAccessorAccess w]
    } else {
        set accessStr "public"
    }
    if {$accessStr != "none"} {
        # there's a remove
    }
    ##  cleanup opposites:
    if {$opposite != ""} {
        if {[$this isQualified] || \
                [$this getMultiplicity] == "many"} {
            # cleanup opposites from classes stored in dictionary
            [$dtor postBody] append \
                    "integer tmp_int_[$this getAssocVariable]\n"
            [$dtor postBody] append \
                    "[[$this ooplType] getName] tmp_cnt_[$this getAssocVariable]\n"
            [$dtor postBody] append \
                    "tmp_cnt_[$this getAssocVariable] = [$this getAssocVariable].firstobject()\n"
            [$dtor postBody] append \
                    "FOR tmp_int_[$this getAssocVariable] = 1 to [$this getAssocVariable].size()\n"
            [$dtor postBody] indent +
            if {[$opposite isQualified] || \
                        [$opposite getMultiplicity] == "many"} {
                [$dtor postBody] append \
                        "if not isNull(tmp_cnt_[$this getAssocVariable].[$opposite getAssocVariable]) then\n"
                [$dtor postBody] indent +
                [$dtor postBody] append \
                        "tmp_cnt_[$this getAssocVariable].[$opposite getAssocVariable].remove(this)\n"
                [$dtor postBody] indent -
                [$dtor postBody] append \
                        "end if\n"
            } else {
                [$dtor postBody] append \
                        "if not isNull(tmp_cnt_[$this getAssocVariable]) then\n"
                [$dtor postBody] indent +
                [$dtor postBody] append \
                        "setNull(tmp_cnt_[$this getAssocVariable].[$opposite getAssocIdentifier])\n"
                [$dtor postBody] indent -
                [$dtor postBody] append \
                        "end if\n"
            }
            [$dtor postBody] append \
                    "tmp_cnt_[$this getAssocVariable] = [$this getAssocVariable].nextobject()\n"
            [$dtor postBody] indent -
            [$dtor postBody] append \
                    "NEXT\n"
        } else {
            if {[$opposite isQualified] || \
                    [$opposite getMultiplicity] == "many"} {
                # clean up opposite which are somewhere present
                # in dictionary or set
                [$dtor postBody] append \
                        "powerobject tmp_[$opposite getAssocIdentifier]\n"
                [$dtor postBody] append \
                        "tmp_[$opposite getAssocIdentifier] = this\n"
                [$dtor postBody] append \
                        "if not isNull([$this getAssocVariable]) then\n"
                [$dtor postBody] indent +
                [$dtor postBody] append \
                        "[$this getAssocVariable].[$opposite getAssocVariable].remove(tmp_[$opposite getAssocIdentifier])\n"
                [$dtor postBody] indent -
                [$dtor postBody] append \
                        "end if\n"
            } else {
                # clean up opposite
                [$dtor postBody] append \
                        "if not isNull([$this getAssocVariable]) then\n"
                [$dtor postBody] indent +
                [$dtor postBody] append \
                        "setNull([$this getAssocVariable].[$opposite getAssocVariable])\n"
                [$dtor postBody] indent -
                [$dtor postBody] append \
                        "end if\n"
            }
        }
    }
    if {[$this isQualified] || [$this getMultiplicity] == "many"} {
        [$dtor postBody] append "destroy($varName)\n"
    }
    [$dtor postBody] append "setNull($varName)\n"
}

method PBGGenAssocAttr::extendAssoc {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.set($qualId, $element)\n"
        }
        set ident [$this getAssocIdentifier]
        return "${prefix}add[cap $ident]($qualId, $element)\n"
    }

    if {[$this getMultiplicity] == "one"} {
        # don't use set method because this will also
        # set its opposite and so will result in loop
        return "$prefix$varName = $element\n"
    }
    # don't use add method because this will also
    # set its opposite and so will result in loop
    return "$prefix$varName.add($element)\n"
}

method PBGGenAssocAttr::reduceAssoc {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 "setNull($prefix$varName)\n"
    }

    return "$prefix$varName.remove($element)\n"
}

method PBGGenAssocAttr::setAssoc {this {prefix ""} {element ""}} {
    if {$prefix != ""} {
        set prefix "${prefix}."
    }

    set retStr ""
    if {$element == ""} {
        set retStr "[[$this ooplType] getName] nullRef\n"
        set retStr "${retStr}setNull(nullRef)\n"
        set element "nullRef"
    }
    set retStr "${retStr}${prefix}set[\
        cap [$this getAssocIdentifier]]($element)\n"
    return $retStr
}

method PBGGenAssocAttr::check {this globalOoplClass class} {
    set errornr 0
    incr errornr [$this checkLocal $globalOoplClass $class]
    return $errornr
}

method PBGGenAssocAttr::checkLocal {this globalOoplClass class} {
    set errornr 0
    incr errornr [$this checkOppositeClass $class]
    incr errornr [$this checkValidAssociation $class]
    return $errornr
}

method PBGGenAssocAttr::checkOppositeClass {this class} {
    set errornr 0
    set type [$this ooplType]
    set ooplClass ""
    # if correct assumption: [$this getThisClass] equals $class.
    if [$type isA OPBaseType] {
        m4_error $E_ASSWITHBASETYPE [$this getName] \
            [[$this getThisClass] getName] [$type getName]
        incr errornr 1
    } elseif [$type isA OPEnumType] {
        m4_error $E_ASSWITHENUMTYPE [$this getName] \
            [[$this getThisClass] getName] [$type getName]
        incr errornr 1
    } else {
        set ooplClass [$type ooplClass]
        if {$ooplClass == ""} {
            m4_error $E_ASSCLASSNONAME [$this getName] \
                [[$this getThisClass] getName]
            incr errornr 1
        }
    }
    return $errornr
}

method PBGGenAssocAttr::checkValidAssociation {this class} {
    set errornr 0
    set thisClass [$this getThisClass]
    set oppClass [$this getOppositeClass]
    if {$oppClass == ""} {
        # error is already given
        incr errornr 1
    } elseif {![$thisClass isGlobalType] || ![$oppClass isGlobalType]} {
        set opposite [$this opposite]
        if {[$thisClass isGlobalType] && \
                ($opposite == "") && \
                [$thisClass getPBClassKind] == ${PBClassKind::Window}} {
            #assoc with window
        } else {
            m4_error $E_ASSGLOBTYPES [$this getName] \
                    [$thisClass getName] [$oppClass getName]
            incr errornr 1
        }
    } elseif {[$oppClass getPBClassKind] == ${PBClassKind::Structure}} {
        m4_error $E_ASSWITHSTRUCT [$this getName] \
            [$thisClass getName] [$oppClass getName]
        incr errornr 1
    } elseif {[$thisClass getBuiltinSuperClass] == ""} {
        # error is already given
        incr errornr 1
    } else {
        set classInfo [[PBBuiltinInfo::global] getBuiltinClass \
                           [$thisClass getBuiltinSuperClassName]]
        if ![$classInfo hasCtorDtor] {
            m4_error $E_ASSCTORDTOR [$this getName] [$thisClass getName] \
                [$oppClass getName] [$thisClass getName]
            incr errornr 1
        } elseif {[$oppClass getBuiltinSuperClass] == ""} {
        # error is already given
            incr errornr 1
        } else {
            set oppClassInfo [[PBBuiltinInfo::global] getBuiltinClass \
                                  [$oppClass getBuiltinSuperClassName]]
            if {[$this opposite] != "" && ![$oppClassInfo hasCtorDtor]} {
                m4_error $E_ASSCTORDTOR [$this getName] [$thisClass getName] \
                    [$oppClass getName] [$oppClass getName]
                incr errornr 1
            }
        }
    }
    return $errornr
}

method PBGGenAssocAttr::checkAssoc {this class} {
    set errornr 0
    return $errornr
}

method PBGGenAssocAttr::checkAssocClass {this class} {
    set errornr 0
    return $errornr
}

# Do not delete this line -- regeneration end marker

if [isCommand CMGenAssocAttr] {
    Class  PBGGenAssocAttrD : {PBGGenAssocAttr CMGenAssocAttr} {
    }
} else {
    Class PBGGenAssocAttrD : {PBGGenAssocAttr OPGenAssocAttr} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPGenAssocAttr) PBGGenAssocAttrD

selfPromoter OPGenAssocAttr {this} {
    PBGGenAssocAttrD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)pbgassocat.tcl    /main/titanic/12


Class PBGAssocAttr : {PBGGenAssocAttr} {
    constructor
    method destructor
    method isAggregation
    method isContainmentAggregation
    method generate
    method checkLocal
    method checkAggregation
}

constructor PBGAssocAttr {class this name} {
    set this [PBGGenAssocAttr::constructor $class $this $name]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBGAssocAttr::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

method PBGAssocAttr::isAggregation {this} {
    set compType [[[$this smConnector] getConnector] type]
    if {$compType == "aggregation"} {
        return 1
    }
    return 0
}

method PBGAssocAttr::isContainmentAggregation {this class} {
    if ![$this isAggregation] {
        return 0
    }

    if [$this isAggregate] {
        set fromClass [$this getThisClass]
        set toClass [$this getOppositeClass]
    } elseif {[$this opposite] != ""} {
        set fromClass [$this getOppositeClass]
        set toClass [$this getThisClass]
    } else {
        return 0
    }

    set containerType [$fromClass getBuiltinSuperClassName]
    set containeeType [$toClass getBuiltinSuperClassName]

    # Is it graphical containment, i.e. is it:
    # - a userobject or window containing a control, or
    # - a tab containing a userobject?
    if {$containerType == "userobject" || $containerType == "window"} {
        set classInfo [[PBBuiltinInfo::global] \
            getBuiltinClass $containeeType]
        if {$classInfo != "" && [$classInfo isControl]} {
            return 1
        }
    }
    if {$containerType == "tab" && $containeeType == "userobject"} {
        return 1
    }

    # Is it a menu containing other menus ?
    if {($containerType == "menu" || $containerType == "menucascade") &&
        ($containeeType == "menu" || $containeeType == "menucascade")} {
        return 1
    }

    # Is it a (global) class having an 'object structure' ?
    if {[$class isGlobalType] && $containeeType == "structure"} {
        return 1
    }

    return 0
}

method PBGAssocAttr::generate {this globalOoplClass class} {
    set oppClass [$this getOppositeClass]
    if {$oppClass == ""} {
        # error is already given
        return
    }

    if [$this isContainmentAggregation $class] {
        if [$this isAggregate] {
            # pb internal lower cases class names
            [$this getOppositeClass] generateAsContainedClass \
                [string tolower [$this getName]] $globalOoplClass \
                [$this getThisClass] $class
        } else {
            # error is already given E_NOREVAGGR
         }
        return
    }

    if [$this isAggregate] {
        # This is an aggregate, but it does not represent a valid
        # containment aggregation
        # warning is already given $W_AGGRASASSOC
    }

    # 'normal' association generation ...
    #
    if ![$this isValidAssociation] {
        # error is already given
        return
    }
    $this genAssocVariable $class
    if {[$this getMultiplicity] == "one"} {
        $this genRemoveOneAccessor $class
        $this genSetAccessor $class
        $this genGetAccessor $class
    } else {
        $this genAddAccessor $class
        $this genRemoveAccessor $class
        $this genGetManyAccessor $class
    }
    $this genCtor $class
    $this genDtor $class
}

method PBGAssocAttr::checkLocal {this globalOoplClass class} {
    set errornr 0
    incr errornr [$this checkOppositeClass $class]
    if { $errornr == 0 } {
        incr errornr [$this checkAggregation $globalOoplClass $class]
    }
    return $errornr
}

method PBGAssocAttr::checkAggregation {this globalOoplClass class} {
    set errornr 0
    set warningnr 0
    if [$this isContainmentAggregation $class] {
        if [$this isAggregate] {
            # ok, after containment loop detection
            incr errornr [[$this getOppositeClass] checkAsContainedClass \
                              [$this getName] $globalOoplClass \
                              [$this getThisClass] $class]
        } else {
            m4_error $E_NOREVAGGR [$this getName] \
                [[$this getThisClass] getName] \
                [[$this getOppositeClass] getName]
            incr errornr 1
        }
        return $errornr
    }
    if [$this isAggregate] {
        # This is an aggregate, but it does not represent a valid
        # containment aggregation
        m4_warning $W_AGGRASASSOC [$this getName] \
            [[$this getThisClass] getName] \
            [[$this getOppositeClass] getName]
        incr warningnr 1
    }
    incr errornr [$this checkValidAssociation $class]

    return $errornr
}

# Do not delete this line -- regeneration end marker

if [isCommand CMAssocAttr] {
    Class  PBGAssocAttrD : {PBGAssocAttr CMAssocAttr} {
    }
} else {
    Class PBGAssocAttrD : {PBGAssocAttr OPAssocAttr} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPAssocAttr) PBGAssocAttrD

selfPromoter OPAssocAttr {this} {
    PBGAssocAttrD promote $this
}



#---------------------------------------------------------------------------
#      File:           @(#)pbglinkatt.tcl    /main/titanic/6


Class PBGLinkAttr : {PBGGenAssocAttr} {
    constructor
    method destructor
    method generate
}

constructor PBGLinkAttr {class this name} {
    set this [PBGGenAssocAttr::constructor $class $this $name]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBGLinkAttr::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

method PBGLinkAttr::generate {this globalOoplClass class} {
    if ![$this isValidAssociation] {
        return
    }
    $this genAssocVariable $class
    if {[$this getMultiplicity] == "one"} {
        $this genGetAccessor $class
    } else {
        $this genGetManyAccessor $class
    }
    $this genCtor $class
    $this genDtor $class
}

# Do not delete this line -- regeneration end marker

if [isCommand CMLinkAttr] {
    Class  PBGLinkAttrD : {PBGLinkAttr CMLinkAttr} {
    }
} else {
    Class PBGLinkAttrD : {PBGLinkAttr OPLinkAttr} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPLinkAttr) PBGLinkAttrD

selfPromoter OPLinkAttr {this} {
    PBGLinkAttrD promote $this
}



#---------------------------------------------------------------------------
#      File:           @(#)pbgqualatt.tcl    /main/titanic/10


Class PBGQualAttr : {PBGGenAssocAttr} {
    constructor
    method destructor
    method generate
    method genGetQualifiedAccessor
    method genRemoveQualifiedAccessor
    method genSetQualifiedAccessor
}

constructor PBGQualAttr {class this name} {
    set this [PBGGenAssocAttr::constructor $class $this $name]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBGQualAttr::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

method PBGQualAttr::generate {this globalOoplClass class} {
    if ![$this isValidAssociation] {
        return
    }
    $this genAssocVariable $class
    $this genGetQualifiedAccessor $class

    if {[$this getMultiplicity] == "one"} {
        $this genSetQualifiedAccessor $class
    } else {
        $this genAddAccessor $class
    }

    $this genRemoveQualifiedAccessor $class
    $this genCtor $class
    $this genDtor $class
}

method PBGQualAttr::genGetQualifiedAccessor {this class} {
    set opposite [$this opposite]
    if {$opposite == ""} {
        set accessStr [$this getAccessorAccess r]
    } else {
        set accessStr "public"
    }
    if {$accessStr == "none"} {
        return
    }

    set varName [$this getAssocVariable]
    set varId [$this getAssocIdentifier]
    set name "get[cap $varId]"
    if {[$this getMultiplicity] == "many"} {
        set type [PBType new "classset"]
    } else {
        set type [[$this ooplType] generate]
    }
    set access [PBAccess new $accessStr]

    set accessor [PBFunction new $name $type $access]
    $class addObjectFunction $accessor

    set qualifier [$this qualifier]
    set qualId [$qualifier getName]
        set type [[$qualifier ooplType] generate]
    set modifier [PBModifier new ""]
    set param [PBParameter new $qualId $type $modifier]
    $accessor addParameter $param

    # The type of a qualifier must be derived from powerobject ...

    # Generate body
    #
    set sect [TextSection new]
    $accessor body $sect
    $sect append "${PBCookie::associationAccessorMethod}\n"
    # note: no cast in powerbuilder
    $sect append "return $varName.get($qualId)\n"
}

method PBGQualAttr::genRemoveQualifiedAccessor {this class} {
    set opposite [$this opposite]
    if {$opposite == ""} {
        set accessStr [$this getAccessorAccess r]
    } else {
        set accessStr "public"
    }
    if {$accessStr == "none"} {
        return
    }

    set ident [$this getAssocIdentifier]

    set name "remove[cap $ident]"
    set type [PBType new ""]
    set access [PBAccess new $accessStr]

    set accessor [PBFunction new $name $type $access]
    $class addObjectFunction $accessor

    set qualifier [$this qualifier]
    set qualId [$qualifier getName]
    set type [[$qualifier ooplType] generate]
    set modifier [PBModifier new ""]
    set param [PBParameter new $qualId $type $modifier]
    $accessor addParameter $param

    # Generate body
    #
    set sect [TextSection new]
    $accessor body $sect
    $sect append "${PBCookie::associationAccessorMethod}\n"

    set paramId "old[cap $ident]"
    set varName [$this getAssocVariable]
    if {[$this getMultiplicity] == "one"} {
        $sect append "powerobject object\n"
        $sect append "object = $varName.get($qualId)\n"
        $sect append "if isNull(object) then\n"
        $sect indent +
        $sect append "return\n"
        $sect indent -
        $sect append "end if\n"
        $sect append [$this reduceAssoc]

        if {$opposite != ""} {
            set typeName [[$this ooplType] getName]
            $sect append "$typeName $paramId\n"
            # note: no cast in powerbuilder
            $sect append "$paramId = object\n"
        }
    } else {
        set type [[$this ooplType] generate]
        set modifier [PBModifier new ""]
        set param [PBParameter new $paramId $type $modifier]
        $accessor addParameter $param

        $sect append "if isNull($paramId) then\n"
        $sect indent +
        $sect append "return\n"
        $sect indent -
        $sect append "end if\n"
        $sect append "classset theSet\n"
        # note: no cast in powerbuilder
        $sect append "theSet = $varName.get($qualId)\n"
        $sect append "if not isNull(theSet) then\n"
        $sect indent +
        $sect append "theSet.remove($paramId)\n"
        $sect indent -
        $sect append "end if\n"
    }
    if {$opposite != ""} {
        $sect append [$opposite reduceAssoc $paramId]
    }
}

method PBGQualAttr::genSetQualifiedAccessor {this class} {
    set opposite [$this opposite]
    if {$opposite == ""} {
        set accessStr [$this getAccessorAccess w]
    } else {
        set accessStr "public"
    }
    if {$accessStr == "none"} {
        return
    }

    set ident [$this getAssocIdentifier]

    set name "set[cap $ident]"
    set type [PBType new ""]
    set access [PBAccess new $accessStr]

    set accessor [PBFunction new $name $type $access]
    $class addObjectFunction $accessor

    set qualifier [$this qualifier]
    set qualId [$qualifier getName]
    set type [[$qualifier ooplType] generate]
    set modifier [PBModifier new ""]
    set param [PBParameter new $qualId $type $modifier]
    $accessor addParameter $param

    set paramId "new[cap $ident]"
    set paramType [[$this ooplType] generate]
    set modifier [PBModifier new ""]
    set param [PBParameter new $paramId $paramType $modifier]
    $accessor addParameter $param

    # Generate body
    #
    set sect [TextSection new]
    $accessor body $sect
    $sect append "${PBCookie::associationAccessorMethod}\n"
    ## when not mandatory empty values allowed.
    if {[$this isMandatory]} {
        $sect append "if isNull($paramId) then\n"
        $sect indent +
        $sect append "return\n"
        $sect indent -
        $sect append "end if\n"
    }
    $sect append "[$this getAssocVariable].set($qualId, $paramId)\n"

    if {$opposite != ""} {
        if {![$this isMandatory]} {
            $sect append "if not isNULL($paramId) then\n"
            $sect indent +
        }
        $sect append [$opposite extendAssoc $paramId]
        if {![$this isMandatory]} {
            $sect indent -
            $sect append "end if\n"
        }
    }
}

# Do not delete this line -- regeneration end marker

if [isCommand CMQualAttr] {
    Class  PBGQualAttrD : {PBGQualAttr CMQualAttr} {
    }
} else {
    Class PBGQualAttrD : {PBGQualAttr OPQualAttr} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPQualAttr) PBGQualAttrD

selfPromoter OPQualAttr {this} {
    PBGQualAttrD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)pbgreverse.tcl    /main/titanic/6


Class PBGReverseLinkAttr : {PBGGenAssocAttr} {
    constructor
    method destructor
    method generate
}

constructor PBGReverseLinkAttr {class this name} {
    set this [PBGGenAssocAttr::constructor $class $this $name]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBGReverseLinkAttr::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

method PBGReverseLinkAttr::generate {this globalOoplClass class} {
    if ![$this isValidAssociation] {
        return
    }
    $this genAssocVariable $class
    if {[$this getMultiplicity] == "one"} {
        $this genGetAccessor $class
    } else {
        $this genGetManyAccessor $class
    }
    $this genCtor $class
    $this genDtor $class
}

# Do not delete this line -- regeneration end marker

if [isCommand CMReverseLinkAttr] {
    Class  PBGReverseLinkAttrD : {PBGReverseLinkAttr CMReverseLinkAttr} {
    }
} else {
    Class PBGReverseLinkAttrD : {PBGReverseLinkAttr OPReverseLinkAttr} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPReverseLinkAttr) PBGReverseLinkAttrD

selfPromoter OPReverseLinkAttr {this} {
    PBGReverseLinkAttrD promote $this
}



#---------------------------------------------------------------------------
#      File:           @(#)pbgqualass.tcl    /main/titanic/4


Class PBGQualAssocAttr : {PBGQualAttr} {
    constructor
    method destructor
}

constructor PBGQualAssocAttr {class this name} {
    set this [PBGQualAttr::constructor $class $this $name]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBGQualAssocAttr::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

# Do not delete this line -- regeneration end marker

if [isCommand CMQualAssocAttr] {
    Class  PBGQualAssocAttrD : {PBGQualAssocAttr CMQualAssocAttr} {
    }
} else {
    Class PBGQualAssocAttrD : {PBGQualAssocAttr OPQualAssocAttr} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPQualAssocAttr) PBGQualAssocAttrD

selfPromoter OPQualAssocAttr {this} {
    PBGQualAssocAttrD promote $this
}



#---------------------------------------------------------------------------
#      File:           @(#)pbgquallin.tcl    /main/titanic/5


Class PBGQualLinkAttr : {PBGQualAttr} {
    constructor
    method destructor
}

constructor PBGQualLinkAttr {class this name} {
    set this [PBGQualAttr::constructor $class $this $name]
    # Start constructor user section
    # End constructor user section
    return $this
}

method PBGQualLinkAttr::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

# Do not delete this line -- regeneration end marker

if [isCommand CMQualLinkAttr] {
    Class  PBGQualLinkAttrD : {PBGQualLinkAttr CMQualLinkAttr} {
    }
} else {
    Class PBGQualLinkAttrD : {PBGQualLinkAttr OPQualLinkAttr} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPQualLinkAttr) PBGQualLinkAttrD

selfPromoter OPQualLinkAttr {this} {
    PBGQualLinkAttrD promote $this
}