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

Text File | 1997-11-07 | 126KB | 5,059 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            : delphioopl.tcl
#       Author          :
#       Original date   : November 1997
#       Description     : Classes for code generation
#
#---------------------------------------------------------------------------


#      File:           @(#)dpgclass.tcl    /main/titanic/24


Class DPGClass : {Object} {
    constructor
    method destructor
    method baseType
    method isGUIComponent
    method isComponent
    method isComponentClass
    method isComponentDummy
    method isControl
    method isDataModule
    method isDerivable
    method isForm
    method getUnitName
    method getClassType
    method getFormVarName
    method getFormTypeName
    method getSuperClass
    method generateComponent
    method generateType
    method generateFormClass
    method generateInterface
    method generateRecord
    method generate
    method check
    method checkComponent
    method checkComponentLocal
    method checkLocal
    attribute bseType
    attribute doneComponent
    attribute target
}

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

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

method DPGClass::baseType {this} {
    set classtype [$this getClassType]
    if {$classtype != "Class"} {
        return [$this bseType]
    }
    if {[$this bseType] == ""} {
        set super $this

        if {[$super getName] != "TForm" &&
            [$super getName] != "TControl" &&
            [$super getName] != "TComponent" &&
            [$super getName] != "TDataModule"} {

            while {[$super getSuperClass] != ""} {
                set super [$super getSuperClass]
                if {[$super getName] == "TForm" ||
                    [$super getName] == "TControl" ||
                    [$super getName] == "TComponent" ||
                    [$super getName] == "TDataModule"} {
                    break;
                }
            }
        }

        switch [$super getName] {
            "TForm"        {
                $this bseType [$super getName]
            }
            "TControl"    {
                $this bseType [$super getName]
            }
            "TComponent"    {
                $this bseType [$super getName]
            }
            "TDataModule"    {
                $this bseType [$super getName]
            }
            default            {
                $this bseType "Class"
            }
        }
    }

    return [$this bseType]
}

method DPGClass::isGUIComponent {this} {
    if {[$this isForm] || [$this isComponent]} {
        return 1
    } else {
        return 0
    }
}

method DPGClass::isComponent {this} {
    if {[$this baseType] == "TComponent" || [$this isControl]} {
        return 1
    } else {
        return 0
    }
}

method DPGClass::isComponentClass {this} {
    if {[$this isGUIComponent] && [$this getPropertyValue "is_declaration"] == 1} {
        return 1
    } else {
        return 0
    }
}

method DPGClass::isComponentDummy {this} {
    if {[$this isComponent] && [$this getPropertyValue "is_declaration"] != "1"} {
        return 1
    } else {
        return 0
    }
}

method DPGClass::isControl {this} {
    if {[$this baseType] == "TControl"} {
        return 1
    } else {
        return 0
    }
}

method DPGClass::isDataModule {this} {
    if {[$this baseType] == "TDataModule"} {
        return 1
    } else {
        return 0
    }
}

method DPGClass::isDerivable {this} {
    if {[$this isComponentDummy]} {
        return 0
    } else {
        return 1
    }
}

method DPGClass::isForm {this} {
    if {[$this baseType] == "TForm" || [$this isDataModule]} {
        return 1
    } else {
        return 0
    }
}

method DPGClass::getUnitName {this} {
    return "[$this getName]Unit"
}

method DPGClass::getClassType {this} {
    set type [$this getPropertyValue "class_type"]
    if {$type == ""} {
        set type "Class"
    }
    return $type
}

method DPGClass::getFormVarName {this} {
    set name [string range [$this getName] 1 [expr [string length [$this getName]] + 1]]
    return $name
}

method DPGClass::getFormTypeName {this} {
    #if {[$this getName] != "TForm" && [$this getName] != "TDataModule"} {
    #    return "T[$this getName]"
    #} else {
        return [$this getName]
    #}
}

method DPGClass::getSuperClass {this} {
    foreach node [$this genNodeSet] {
        set classtype [[$node superClass] getClassType]
        if {$classtype == "Class"} {
            return [$node superClass]
        }
    }
    return ""
}

method DPGClass::generateComponent {this role class control} {
    if {[$this checkComponentLocal $role [$class form]] > 0} {
        return
    }

    # Create new component
    #
    set ctrlType [[$this getSuperClass] generateType]
    set newcontrol [DPControl new $ctrlType]
    $newcontrol name $role
    set props [DPTextSection new]
    $newcontrol properties $props
    $newcontrol compclass [$this getName]

    # Add new component to child list of parent
    $control addChild $newcontrol

    # Set Field property
    $control controlType "normal"
    if {[$this isComponent] && ([$this isControl] == 0)} {
        set super $this
        while {[$super getSuperClass] != ""} {
            if {[$super getName] == "TField"} {
                $newcontrol controlType "TField"
                break;
            }
            set super [$super getSuperClass]
        }
    }

    # Add new component to form
    [$class form] setControl [$newcontrol name] $newcontrol

    # Generate child components
    $this doneComponent 1
    foreach assoc [$this genAssocAttrSet] {
        if {[$assoc hasGUIComponent]} {
            $assoc generateComponent $class $newcontrol
        }
    }
    $this doneComponent 0

    # Generate events
    foreach operation [$this operationSet] {
        if {[$operation isEvent]} {
            set event [$operation generateEvent $class $newcontrol]
            # Only add event if found
            if {$event != ""} {
                set controlevent [DPControlEvent new $event]
                $controlevent name [$operation getName]
                $newcontrol addEvent $controlevent
            }
        }
    }
}

method DPGClass::generateType {this} {
    set type [DPType new]
    $type includeType "user"
    $type includeName [$this getUnitName]
    if {[$this isForm]} {
        $type name [$this getFormTypeName]
    } else {
        $type name "[$this getName]"
    }

    set libunit [$this getPropertyValue "libunit"]
    if {$libunit != "None" && $libunit != ""} {
        $type includeType "system"
        if {$libunit == "Other"} {
            $type includeName [$this getPropertyValue "userlib"]
        } else {
            $type includeName $libunit
        }
    }
    return $type
}

method DPGClass::generateFormClass {this tgt unit form} {

    # Set form instance properties
    $form name "[$this getFormVarName]"
    set props [DPTextSection new]
    $form properties $props

    $unit name [[$form type] name]
    $this target $unit

    # Create global form variable
    set formvar [DPVariable new [$form type]]
    $formvar name "[$this getFormVarName]"
    $formvar formVar 1
    $unit addGlobvar $formvar

    # Hook form to project
    $tgt setForm [$formvar name] $form

    # Generate events
    foreach operation [$this operationSet] {
        if {[$operation isEvent]} {
            set event [$operation generateEvent $unit $form]
            # Only add events if found
            if {$event != ""} {
                set controlevent [DPControlEvent new $event]
                $controlevent name [$operation getName]
                $form addEvent $controlevent
            }
        }
    }

    # Generate components
    foreach assoc [$this genAssocAttrSet] {
        if {[$assoc hasGUIComponent]} {
            $assoc generateComponent $unit $form
        }
    }
}

method DPGClass::generateInterface {this tgt} {
    set unit [DPInterfaceUnit new]
    $this target $unit
    set type [$this generateType]
    $unit name "[$type name]"

    # Hook to project

    $tgt setUnit [$this getName] $unit

    # Set unit attributes

    $unit unitName "[$this getUnitName]"

    # comment

    set comment [DPComment new]
    $unit comment $comment
    $comment comment [$this getPropertyValue "freeText"]

    # identifier

    $unit interface_id [$this getPropertyValue "interface_id"]

    # Generate superclass

    foreach genNode [$this genNodeSet] {
        $genNode generate $unit
    }

    # Generate methods

    foreach feature [$this operationSet] {
        $feature generate $unit
    }

    # Generate properties (attributes)

    foreach feature [$this dataAttrSet] {
        $feature generate $unit
    }
}

method DPGClass::generateRecord {this tgt} {
    set unit [DPRecordUnit new]
    $this target $unit
    set type [$this generateType]
    $unit name "[$type name]"

    # Hook to project

    $tgt setUnit [$this getName] $unit

    # Set unit attributes

    $unit unitName "[$this getUnitName]"

    # comment

    set comment [DPComment new]
    $unit comment $comment
    $comment comment [$this getPropertyValue "freeText"]

    # Generate attributes

    foreach feature [$this dataAttrSet] {
        $feature generate $unit
    }
}

method DPGClass::generate {this tgt} {
    if {[$this checkLocal] > 0} {
        return
    }

    # Check if class is a record class

    if {[$this getClassType] == "Record"} {
        $this generateRecord $tgt
        return
    }

    # Check if class is an interface class

    if {[$this getClassType] == "Interface"} {
        $this generateInterface $tgt
        return
    }

    # Hook unit to project

    switch [$this baseType] {
        "TDataModule" {

            # Create data module class
            #
            set formtype [$this generateType]
            set form [DPForm new $formtype]
            set unit [DPFormClass new $form]
            $unit formType "datamodule"

            $this generateFormClass $tgt $unit $form
        }
        "TForm" {

            # Create form class
            #
            set formtype [$this generateType]
            set form [DPForm new $formtype]
            set unit [DPFormClass new $form]

            $this generateFormClass $tgt $unit $form
        }
        "Class" {
            set unit [DPClass new]
            $this target $unit
            set type [$this generateType]
            $unit name "[$type name]"
        }
        "TControl" -
        "TComponent" {
            if {[$this isComponentDummy]} {
                return
            }
            set unit [DPClass new]
            $this target $unit
            set type [$this generateType]
            $unit name "[$type name]"
        }
        default {
            return
        }
    }
    $tgt setUnit [$this getName] $unit

    # Set unit attributes

    $unit unitName "[$this getUnitName]"

    # comment

    set comment [DPComment new]
    $unit comment $comment
    $comment comment [$this getPropertyValue "freeText"]

    # Generate superclass

    foreach genNode [$this genNodeSet] {
        $genNode generate $unit
    }

    # Generate attributes

    foreach feature [$this dataAttrSet] {
        $feature generate $unit
    }

    # Generate methods

    foreach feature [$this operationSet] {
        $feature generate $unit
    }

    # Generate constructor

    if {[$this constructor] != ""} {
        [$this constructor] generate $unit
    }

    # Generate destructor

    set dtor [DPDestructor new]
    $dtor isOverride 1
    $dtor name "Destroy"
    $dtor access "Public"
    $dtor userCodeFirst 1
    $dtor gencode [DPTextSection new]
    $dtor gentypes [DPTextSection new]
    $unit destructr $dtor

    # Generate associations

    foreach assoc [$this genAssocAttrSet] {
        $assoc generate $unit
    }

    # Old destructor is last thing to call in a destructor
    [$dtor gencode] append "\ninherited Destroy;\n"
}

method DPGClass::check {this} {

    set errornr [$this checkLocal]
    set componentList ""

    # Form class components
    if {[$this isForm]} {
        set form [DPForm new [DPType new]]
        foreach assoc [$this genAssocAttrSet] {
            if {[$assoc hasGUIComponent]} {
                $assoc checkComponent $form
            }
        }
    }
    # Superclasses
    foreach genNode [$this genNodeSet] {
        incr errornr [$genNode check]
    }
    # Attributes
    foreach feature [$this dataAttrSet] {
        incr errornr [$feature check]
    }
    # Methods
    foreach feature [$this operationSet] {
        incr errornr [$feature check]
    }
    # Constructor
    if {[$this constructor] != ""} {
        incr errornr [[$this constructor] check]
    }
    # Associations
    foreach assoc [$this genAssocAttrSet] {
        incr errornr [$assoc check]
    }

    return $errornr
}

method DPGClass::checkComponent {this componentName form} {
    set errornr [$this checkComponentLocal $componentName $form]
    set tmpControl [DPControl new [DPType new]]
    $form setControl $componentName $tmpControl

    # Check child components
    $this doneComponent 1
    foreach assoc [$this genAssocAttrSet] {
        if {[$assoc hasGUIComponent]} {
            incr errornr [$assoc checkComponent $form]
        }
    }
    $this doneComponent 0

    # Check events
    foreach operation [$this operationSet] {
        if {[$operation isEvent]} {
            incr errornr [$operation checkEvent $componentName]
        }
    }
    return $errornr
}

method DPGClass::checkComponentLocal {this componentName form} {
    set errornr 0

    # Check for double defined components
    #
    if {![$this isForm]} {
        if {[$form getControl $componentName] != ""} {
            m4_error $E_COMPDBDEF $componentName
            incr errornr 1
        }
    }

    # Check for component loop
    #
    if {[$this doneComponent] == 1} {
        m4_error $E_COMPLOOP $componentName
        incr errornr 1
    }

    # Check if all methods are events for components
    #
    foreach operation [$this operationSet] {
        if {![$operation isEvent]} {
            if {![$this isForm]} {
                m4_error $E_CANTCONTMETH [$this getName]
                incr errornr 1
            }
        }
    }

    # Check associations
    #

    if {[$this isComponent]} {
        foreach assoc [$this genAssocAttrSet] {
            if {![$assoc hasGUIComponent]} {
                m4_error $E_CANTCONTASSOC $componentName
                incr errornr 1
            }
        }
    }

    # Check that components only contain components and controls only contain controls (except TForm)
    #

    if {[$this isComponent] || [$this isDataModule]} {
        if {[$this isControl]} {
            foreach assoc [$this genAssocAttrSet] {
                if {[$assoc hasGUIComponent] != "2"} {
                    m4_error $E_CANTCONTCOMP [$this getName] [$assoc getName]
                    incr errornr 1
                }
            }
        } else {
            foreach assoc [$this genAssocAttrSet] {
                if {[$assoc hasGUIComponent] != "1"} {
                    m4_error $E_CANTCONTCTRL $componentName [$assoc getName]
                    incr errornr 1
                }
            }
        }
    }

    # Check Attributes
    #
    if {![$this isForm]} {
        if {[llength [$this dataAttrSet]] > 0}  {
            m4_error $E_CANTCONTATTR $componentName
            incr errornr 1
        }
    }

    return $errornr
}

method DPGClass::checkLocal {this} {
    set errornr 0

    # Check form name
    #
    if {[$this isForm]} {
        if {[string length [$this getFormTypeName]] < 2} {
            incr errornr
            m4_error $E_FORMMINTWO [$this getFormTypeName]
        }
        if {[string index [string toupper [$this getFormTypeName]] 0] != "T"} {
            incr errornr
            m4_error $E_FORMFIRSTT [$this getFormTypeName]
        }
        set tmpchar [string index [$this getFormTypeName] 1]
        if {![string match {[A-Za-z]} $tmpchar]} {
            incr errornr
            m4_error $E_FORMMINTWO [$this getFormTypeName]
        }
    }

    # Check if correct class type
    #
    set classtype [$this getClassType]
    if {($classtype != "Class") && \
        ($classtype != "Interface") && \
        ($classtype != "Record")} {
        incr errornr
        m4_error $E_ILLCLASSTYPE [$this getName]
    }

    # Check record class
    #
    if {$classtype == "Record"} {
        if {[$this operationSet] != ""} {
            incr errornr
            m4_error $E_NOMETHODS [$this getName]
        }
    }

    # Check for GUI associations
    #
    foreach assoc [$this genAssocAttrSet] {
        if {[$this baseType] == "Class"} {
            # ToDo: Modify this when class declarations are possible
            if {[[[$assoc ooplType] ooplClass] isComponentDummy]} {
                m4_error $E_CANTCONTGUI [$this getName] [[[$assoc ooplType] ooplClass] getName]
                incr errornr 1
            }
        }
    }

    # Check for multiple inheritance
    #
    if {[$this genNodeSet] != ""} {
        set class_supers 0
        set intface_supers 0
        foreach node [$this genNodeSet] {
            set ctype [[$node superClass] getClassType]
            if {$ctype == "Class"} {
                incr class_supers
            }
            if {$ctype == "Interface"} {
                incr intface_supers
            }
        }
        if {$class_supers > 1} {
            m4_error $E_MULTINH [$this getName]
            incr errornr 1
        }

        # Check super for interface classes
        #
        if {$classtype == "Interface"} {
            if {($intface_supers > 1) || ($class_supers != 0)} {
                m4_error $E_INTFACEINH [$this getName]
                incr errornr 1
            }
        }
        # Check super for classes with interface inheritance
        #
        if {$classtype == "Class"} {
            if {($intface_supers > 0) && ($class_supers == 0)} {
                m4_error $E_INHNOCLASS [$this getName]
                incr errornr 1
            }
        }
    }
    # Check interface class
    #
    if {$classtype == "Interface"} {
        # Attributes
        foreach feature [$this dataAttrSet] {
            if {![$feature isProperty]} {
                m4_error $E_ONLYPROPS [$this getName] [$feature getName]
                incr errornr 1
            }
        }
        # Associations
        if {[$this genAssocAttrSet] != ""} {
            m4_error $E_NOASSOC [$this getName]
            incr errornr 1
        }
    }

    # Check form components
    #
    if {[$this isForm]} {
        $this checkComponentLocal [$this getName] ""
    }

    return $errornr
}

# Do not delete this line -- regeneration end marker

if [isCommand CMClass] {
    Class  DPGClassD : {DPGClass CMClass} {
    }
} else {
    Class DPGClassD : {DPGClass OPClass} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPClass) DPGClassD

selfPromoter OPClass {this} {
    DPGClassD promote $this
}


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


Class DPGFeature : {Object} {
    constructor
    method destructor
    method check
    method checkLocal
    method generate
}

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

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

method DPGFeature::check {this} {
    set errornr [$this checkLocal]
    return $errornr
}

method DPGFeature::checkLocal {this} {
    set errornr 0
    return $errornr
}

method DPGFeature::generate {this} {
}

# Do not delete this line -- regeneration end marker

if [isCommand CMFeature] {
    Class  DPGFeatureD : {DPGFeature CMFeature} {
    }
} else {
    Class DPGFeatureD : {DPGFeature OPFeature} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPFeature) DPGFeatureD

selfPromoter OPFeature {this} {
    DPGFeatureD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)dpginhgrou.tcl    /main/titanic/7


Class DPGInhGroup : {Object} {
    constructor
    method destructor
    method check
    method checkLocal
    method generate
}

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

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

method DPGInhGroup::check {this} {
    set errornr [$this checkLocal]
    return $errornr
}

method DPGInhGroup::checkLocal {this} {
    set errornr 0

    if {![[$this superClass] isDerivable]} {
        m4_error $E_ILLSUPER [[$this superClass] getName]
        incr errornr 1
    }
    return $errornr
}

method DPGInhGroup::generate {this class} {
    if {[$this checkLocal] > 0} {
        return
    }
    set superclasstype [[$this superClass] getClassType]
    set classtype [$class unitType]
    if {($classtype == "class") || ($classtype == "formclass")} {
        if {$superclasstype == "Class"} {
            $class superclass [[$this superClass] generateType]
        } else {
            if {$superclasstype == "Interface"} {
                    $class addSuperinterface [[$this superClass] generateType]
            }
        }
    } else {
        if {$classtype == "interface"} {
            if {$superclasstype == "Interface"} {
                $class super [[$this superClass] generateType]
            }
        }
    }
}

# Do not delete this line -- regeneration end marker

if [isCommand CMInhGroup] {
    Class  DPGInhGroupD : {DPGInhGroup CMInhGroup} {
    }
} else {
    Class DPGInhGroupD : {DPGInhGroup OPInhGroup} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPInhGroup) DPGInhGroupD

selfPromoter OPInhGroup {this} {
    DPGInhGroupD promote $this
}


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


Class DPGInitializer : {Object} {
    constructor
    method destructor
    method check
    method checkLocal
    method generate
}

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

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

method DPGInitializer::check {this} {
    set errornr [$this checkLocal]
    return $errornr
}

method DPGInitializer::checkLocal {this} {
    set errornr 0
    return $errornr
}

method DPGInitializer::generate {this ctor} {
}

# Do not delete this line -- regeneration end marker

if [isCommand CMInitializer] {
    Class  DPGInitializerD : {DPGInitializer CMInitializer} {
    }
} else {
    Class DPGInitializerD : {DPGInitializer OPInitializer} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPInitializer) DPGInitializerD

selfPromoter OPInitializer {this} {
    DPGInitializerD promote $this
}


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


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

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

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

method DPGParameter::check {this} {
    set errornr [$this checkLocal]
    incr errornr [[$this ooplType] check]
    return $errornr
}

method DPGParameter::checkLocal {this} {
    set errornr 0
    return $errornr
}

# Do not delete this line -- regeneration end marker

if [isCommand CMParameter] {
    Class  DPGParameterD : {DPGParameter CMParameter} {
    }
} else {
    Class DPGParameterD : {DPGParameter OPParameter} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPParameter) DPGParameterD

selfPromoter OPParameter {this} {
    DPGParameterD promote $this
}


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


Class DPGType : {Object Object} {
    constructor
    method destructor
    method check
    method checkLocal
    method generate
    method generateParamType
    method generateAttribType
    method getAttribTypeModifier
    method getParamTypeModifier
}

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

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

method DPGType::check {this} {
    set errornr [$this checkLocal]
    return $errornr
}

method DPGType::checkLocal {this} {
    set errornr 0
    return $errornr
}

method DPGType::generate {this} {

    if {[$this ooplClass] != ""} {
        set type [[$this ooplClass] generateType]
    } else {
        set type [DPType new]
        $type includeType "user"
        $type includeName ""
        $type name ""
    }
    return $type
}

method DPGType::generateParamType {this} {
    set tgtType [$this generate]
    set modifier [$this getParamTypeModifier]

    if {$modifier == ""} {
        return $tgtType
    }
    switch $modifier {
        ""    {
        }
        "Untyped" {
            $tgtType name ""
            $tgtType includeType "none"
        }
        "Open-array" {
            $tgtType name "array of [$tgtType name]"
        }
        "Variant Open-array" {
            $tgtType name "array of const"
            $tgtType includeType "none"
        }
        default {
            $tgtType name $modifier
        }
    }
    return $tgtType
}

method DPGType::generateAttribType {this} {
    set tgtType [$this generate]
    set modifier [$this getAttribTypeModifier]

    if {$modifier == ""} {
        return $tgtType
    }
    switch $modifier {
        ""    {
        }
        "Pointer" {
            $tgtType name "^[$tgtType name]"
        }
        "File" {
            $tgtType name "file of [$tgtType name]"
        }
        "Untyped" {
            $tgtType name ""
            $tgtType includeType "none"
        }
        default {
            $tgtType name $modifier
        }
    }
    return $tgtType
}

method DPGType::getAttribTypeModifier {this} {
    set modifier [$this getPropertyValue "attrib_mod"]

    if {$modifier == "Default"} {
        return ""
    }
    if {$modifier == "Other"} {
        return [string trim [$this getPropertyValue "attrib_othermod"]]
    }
    return $modifier
}

method DPGType::getParamTypeModifier {this} {
    set modifier [$this getPropertyValue "param_mod"]

    if {$modifier == "Default"} {
        return ""
    }
    if {$modifier == "Other"} {
        return [string trim [$this getPropertyValue "param_othermod"]]
    }
    return $modifier
}

# Do not delete this line -- regeneration end marker

if [isCommand CMType] {
    Class  DPGTypeD : {DPGType CMType} {
    }
} else {
    Class DPGTypeD : {DPGType OPType} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPType) DPGTypeD

selfPromoter OPType {this} {
    DPGTypeD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)dpgassocge.tcl    /main/titanic/11


Class DPGAssocGen : {GCObject} {
    constructor
    method destructor
    method propRead
    method propWrite
    method propAccess
    method hasGet
    method checkLocal
    method check
    method generateType
    method castType
    method assocattr
    attribute varname
    attribute varref
    attribute varset
    attribute vardict
    attribute varqual
    attribute opvarname
    attribute opvarref
    attribute opvarset
    attribute opvardict
    attribute addWarning
    attribute setWarning
    attribute getWarning
    attribute removeWarning
    attribute dtorWarning
    attribute typename
    attribute _assocattr
}

constructor DPGAssocGen {class this assocattr} {
    set this [GCObject::constructor $class $this]
    $this addWarning 0
    $this setWarning 0
    $this getWarning 0
    $this removeWarning 0
    $this dtorWarning 0
    $this _assocattr $assocattr
    $assocattr _generator $this
    # Start constructor user section

    $this varname [[$this assocattr] getName]
    $this varref "[$this varname]Ref"
    $this varset "[$this varname]Set"
    $this vardict "[$this varname]Dict"
    $this typename [[[[$this assocattr] ooplType] ooplClass] getName]

    if {[[$this assocattr] get_obj_type] == "qual_assoc_attrib" || [[$this assocattr] get_obj_type] == "qual_link_attrib"} {
        $this varqual [[[$this assocattr] qualifier] getName]
    }
    if {[[$this assocattr] opposite] != ""} {
        $this opvarname [[[$this assocattr] opposite] getName]
        $this opvarref "[$this opvarname]Ref"
        $this opvarset "[$this opvarname]Set"
        $this opvardict "[$this opvarname]Dict"
    }
    # End constructor user section
    return $this
}

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

method DPGAssocGen::propRead {this} {
    set accessList [split [[$this assocattr] getPropertyValue assoc_access] -]
    set accessStr [lindex $accessList 0]
    if {$accessStr == ""} {
        set accessStr "Public"
    }
    return $accessStr
}

method DPGAssocGen::propWrite {this} {
    set accessList [split [[$this assocattr] getPropertyValue assoc_access] -]
    set accessStr [lindex $accessList 1]
    if {$accessStr == ""} {
        set accessStr "Public"
    }
    return $accessStr
}

method DPGAssocGen::propAccess {this} {
    set access [[$this assocattr] getPropertyValue assoc_visibility]
    if {$access == ""} {
        set access "Private"
    }
    return $access
}

method DPGAssocGen::hasGet {this self} {
    set rd [$this propRead]
    if {$self} {
        if {$rd == "None"} {
            return 0
        }
    } else {
        if {$rd == "None" || $rd == "Private" || $rd == "Protected"} {
            return 0
        }
    }
    return 1
}

method DPGAssocGen::checkLocal {this} {
    set errornr 0

    # Check for mtory-mtory
    #
    set assoc [$this assocattr]
    set oppos [[$this assocattr] opposite]
    if {$oppos != ""} {
        if {[$assoc isMandatory] && [$assoc getMultiplicity] == "one" && ![$assoc isQualified]} {
            if {[$oppos isMandatory] && [$oppos getMultiplicity] == "one" && ![$oppos isQualified]} {
                m4_error $E_MTORYMTORY [[[[$this assocattr] opposite] ooplClass] getName] [[[$this assocattr] ooplClass] getName]
                incr errornr 1
            }
        }
        if {[$assoc getPropertyValue "assoc_implement"] == "Object reference"} {
            if {[$oppos getPropertyValue "assoc_implement"] == "Object reference"} {
                m4_error $E_OBJREFASSIMP [$assoc getName]
            }
        }
    }
    if {[[[$assoc ooplType] ooplClass] getClassType] == "Interface"} {
        m4_error $E_NOCLASSASSOC [[[$assoc ooplType] ooplClass] getName]
        incr errornr 1
    }

    return $errornr
}

method DPGAssocGen::check {this} {
    set errornr [$this checkLocal]

    return $errornr
}

method DPGAssocGen::generateType {this cl} {
    if {[[$this assocattr] getPropertyValue "assoc_implement"] == "Object reference"} {
        set type [[[[$this assocattr] ooplType] ooplClass] generateType]
    } else {
        # To include the right unit
        [$this assocattr] generateAssocType $cl
        set type [DPType new]
        $type name "Pointer"
    }
    return $type
}

method DPGAssocGen::castType {this str} {
    if {[[$this assocattr] getPropertyValue "assoc_implement"] == "Object reference"} {
        return $str
    } else {
        return "[$this typename](${str})"
    }
}

# Do not delete this line -- regeneration end marker

method DPGAssocGen::assocattr {this args} {
    if {$args == ""} {
        return [$this _assocattr]
    }
    set ref [$this _assocattr]
    if {$ref != ""} {
        $ref _generator ""
    }
    set obj [lindex $args 0]
    if {$obj != ""} {
        $obj _generator $this
    }
    $this _assocattr $obj
}



#---------------------------------------------------------------------------
#      File:           @(#)dpgclassen.tcl    /main/titanic/9


Class DPGClassEnum : {DPGClass} {
    constructor
    method destructor
    method isDerivable
    method generate
    method checkLocal
    method check
}

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

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

method DPGClassEnum::isDerivable {this} {
    return 0
}

method DPGClassEnum::generate {this tgt} {
    if {[$this checkLocal] > 0} {
        return
    }
    set unit [DPEnumUnit new]
    set type [$this generateType]
    $unit name "[$type name]"

    $tgt setUnit [$this getName] $unit
    $unit unitName "[$this getUnitName]"

    set comment [DPComment new]
    $unit comment $comment
    $comment comment [$this getPropertyValue "freeText"]

    # Generate enum fields
    foreach feature [$this dataAttrSet] {
        set comp [DPEnumComponent new]
        $comp name [$feature getName]
        $unit addComponent $comp
    }
    if {[$this getClassType] == "Set"} {
        $unit isSet 1
    }
}

method DPGClassEnum::checkLocal {this} {
    set errornr 0

    # Check class type
    #
    set classtype [$this getPropertyValue "class_type"]
    if {($classtype != "") && ($classtype != "Class") && ($classtype != "Set")} {
        incr errornr
        m4_error $E_ILLCLASSTYPE [$this getName]
    }

    # Check data attributes
    #
    # Note: put here since it is no generate is called from the data attribute!
    foreach feature [$this dataAttrSet] {
        incr errornr [$feature check]
    }

    # Check initial values
    #
    foreach feature [$this dataAttrSet] {
        if {[$feature getInitialValue] != ""} {
            m4_warning $W_ENUMDEFAULT [$this getName]
            incr errornr 1
        }
    }
    return $errornr
}

method DPGClassEnum::check {this} {
    set errornr [$this checkLocal]
    return $errornr
}

# Do not delete this line -- regeneration end marker

if [isCommand CMClassEnum] {
    Class  DPGClassEnumD : {DPGClassEnum CMClassEnum} {
    }
} else {
    Class DPGClassEnumD : {DPGClassEnum OPClassEnum} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPClassEnum) DPGClassEnumD

selfPromoter OPClassEnum {this} {
    DPGClassEnumD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)dpgclassge.tcl    /main/titanic/7


Class DPGClassGenericTypeDef : {DPGClass} {
    constructor
    method destructor
    method isDerivable
    method generate
    method checkLocal
    method check
}

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

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

method DPGClassGenericTypeDef::isDerivable {this} {
    return 0
}

method DPGClassGenericTypeDef::generate {this tgt} {

    if {[$this checkLocal] > 0} {
        return
    }

    set unit [DPTypeDefUnit new]
    set type [$this generateType]
    $unit name "[$type name]"

    set assoc [lindex [$this genAssocAttrSet] 0]
    if {[$assoc isQualified]} {
        set typedefType [$assoc generateQualAssocType $unit]
    } else {
        if {[$assoc getMultiplicity] == "many"} {
            set typedefType [$assoc generateManyAssocType $unit]
        } else {
            set typedefType [[$assoc ooplType] generate]
        }
    }

    $unit unitName "[$this getUnitName]"
    $unit typedefType $typedefType
    $tgt setUnit [$this getName] $unit

    set comment [DPComment new]
    $unit comment $comment
    $comment comment [$this getPropertyValue "freeText"]
}

method DPGClassGenericTypeDef::checkLocal {this} {
    set errornr 0

    if {[lindex [$this genAssocAttrSet] 0] == ""} {
        m4_error $E_GENTDEFTYPE [$this getName]
        incr errornr
    }
    return $errornr
}

method DPGClassGenericTypeDef::check {this} {
    set errornr [$this checkLocal]

    return $errornr
}

# Do not delete this line -- regeneration end marker

if [isCommand CMClassGenericTypeDef] {
    Class  DPGClassGenericTypeDefD : {DPGClassGenericTypeDef CMClassGenericTypeDef} {
    }
} else {
    Class DPGClassGenericTypeDefD : {DPGClassGenericTypeDef OPClassGenericTypeDef} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPClassGenericTypeDef) DPGClassGenericTypeDefD

selfPromoter OPClassGenericTypeDef {this} {
    DPGClassGenericTypeDefD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)dpgclasstd.tcl    /main/titanic/13


Class DPGClassTDef : {DPGClass} {
    constructor
    method destructor
    method isDerivable
    method getFinalType
    method getType
    method generate
    method checkLocal
    method check
    attribute cid
    attribute finalType
}

global DPGClassTDef::gid
set DPGClassTDef::gid 0


constructor DPGClassTDef {class this name} {
    set this [DPGClass::constructor $class $this $name]
    $this finalType null
    # Start constructor user section
    # End constructor user section
    return $this
}

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

method DPGClassTDef::isDerivable {this} {
    set type [$this getFinalType]

    if {$type != ""} {
        if {[$type isA OPBaseType] || [$type isA OPTypeDefType] || [$type isA OPEnumType]} {
            return 0
        }
        if {[$type isA OPClassType] && [[$type ooplClass] isComponentDummy]} {
            return 0
        }
    }
    return 1
}

method DPGClassTDef::getFinalType {this} {
    # return the (final) type to which this typedef really refers, i.e. resolve
    #  the typedef trail until a non-typedef is discovered
    # note: this func returns an OPTypeDefType in case of a typedef that refers
    #        to itself
    # currently, this is done non-recursively...
    #
    # note: copy from Forte generator
    #

    # Note! Constructor is not called so initialization is done in promotor!!
    #
    if {[$this finalType] != "null"} {
    return [$this finalType]
    }

    global DPGClassTDef::gid
    incr DPGClassTDef::gid
    set id ${DPGClassTDef::gid}
    $this cid $id

    set type [$this getType]
    while {1} {
        if {$type == ""} {
            $this finalType ""
            return ""
        }
        if {![$type isA OPTypeDefType]} {
            $this finalType $type
            return $type
        }
        set class [$type ooplClass]
        if {$class == ""} {
            $this finalType ""
            return ""
        }
        if {![$class isA OPClassTDef]} {
            $this finalType $type
            return $type
        }
        if {$id == [$class cid]} {
            # loop detected
            $this finalType $type
            return $type
        }
        if {[$class getName] == ""} {
            $this finalType ""
            return ""
        }
        $class cid $id
        set type [$class getType]
    }
}

method DPGClassTDef::getType {this} {
    # note: this method should have been a member of OPClassTDef
    #
    set attr [lindex [$this dataAttrSet] 0]
    if {$attr == ""} {
        return ""
    }

    # hack: if attr has no type, the OOPL model returns an OPClassType without
    #  an OPCLass... or an OPClass having no name... !!!
    #
    set type [$attr ooplType]
    if {[$type isA OPClassType]} {
        if {[$type ooplClass] == "" || [[$type ooplClass] getName] == ""} {
            return ""
        }
    }
    return $type
}

method DPGClassTDef::generate {this tgt} {
    set unit [DPTypeDefUnit new]
    set type [$this generateType]
    $unit typedefType [[[$this dataAttrSet] ooplType] generateAttribType]
    $unit name "[$type name]"

    $tgt setUnit [$this getName] $unit
    $unit unitName "[$this getUnitName]"

    set comment [DPComment new]
    $unit comment $comment
    $comment comment [$this getPropertyValue "freeText"]
}

method DPGClassTDef::checkLocal {this} {
    set errornr 0

    set classtype [$this getClassType]
    if {($classtype != "Class")} {
        incr errornr
        m4_error $E_ILLCLASSTYPE [$this getName]
    }

    return $errornr
}

method DPGClassTDef::check {this} {
    set errornr [$this checkLocal]

    foreach feature [$this dataAttrSet] {
        incr errornr [$feature check]
    }
    return $errornr
}

# Do not delete this line -- regeneration end marker

if [isCommand CMClassTDef] {
    Class  DPGClassTDefD : {DPGClassTDef CMClassTDef} {
    }
} else {
    Class DPGClassTDefD : {DPGClassTDef OPClassTDef} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPClassTDef) DPGClassTDefD

selfPromoter OPClassTDef {this} {
    DPGClassTDefD promote $this
}


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


Class DPGLinkClass : {DPGClass} {
    constructor
    method destructor
    method isDerivable
}

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

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

method DPGLinkClass::isDerivable {this} {
    return 0
}

# Do not delete this line -- regeneration end marker

if [isCommand CMLinkClass] {
    Class  DPGLinkClassD : {DPGLinkClass CMLinkClass} {
    }
} else {
    Class DPGLinkClassD : {DPGLinkClass OPLinkClass} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPLinkClass) DPGLinkClassD

selfPromoter OPLinkClass {this} {
    DPGLinkClassD promote $this
}


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


Class DPGAttribute : {DPGFeature} {
    constructor
    method destructor
}

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

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

# Do not delete this line -- regeneration end marker

if [isCommand CMAttribute] {
    Class  DPGAttributeD : {DPGAttribute CMAttribute} {
    }
} else {
    Class DPGAttributeD : {DPGAttribute OPAttribute} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPAttribute) DPGAttributeD

selfPromoter OPAttribute {this} {
    DPGAttributeD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)dpgconstru.tcl    /main/titanic/18


Class DPGConstructor : {DPGFeature} {
    constructor
    method destructor
    method check
    method generate
    attribute counted
}

constructor DPGConstructor {class this name} {
    set this [DPGFeature::constructor $class $this $name]
    $this counted 0
    # Start constructor user section
    # End constructor user section
    return $this
}

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

method DPGConstructor::check {this} {
    set errornr [$this checkLocal]

    # check initializers
    foreach initializer [$this initializerSet] {
        incr errornr [$initializer check]
    }

    # check parameters
    foreach param [[$this ooplClass] creationParamSet] {
        if {![$param isGUIComponent [$this ooplClass]]} {
            incr errornr [$param check]
        }
    }

    return $errornr
}

method DPGConstructor::generate {this class} {
    if {([$this counted] == "") || ([$this counted] == "0")} {
        $class userConstructors [expr [$class userConstructors] + 1]
        $this counted 1
    }

    set ctor [DPConstructor new]
    set comment [DPComment new]
    $ctor comment $comment
    $comment comment [$this getPropertyValue "freeText"]

    $ctor name "Create"
    $ctor access [$this getPropertyValue "method_access"]

    # ToDo: Check for automatic override generation?
#    $ctor isOverride 1

    # method calling

    $ctor methodCalling [$this getPropertyValue "method_calling"]

    # method modifier
    set modif [$this getPropertyValue "method_modifier"]

    switch $modif {
        "Virtual"    {
            $ctor isVirtual 1
        }
        "Dynamic"    {
            $ctor isDynamic 1
        }
        "Virtual Abstract"    {
            $ctor isAbstract 1
            $ctor isVirtual 1
        }
        "Dynamic Abstract"    {
            $ctor isAbstract 1
            $ctor isDynamic 1
        }
        "Override"    {
            $ctor isOverride 1
        }
        default    {
        }
    }

    if {[$ctor access] == ""} {
        $ctor access "Public"
    }
    set gencode [DPTextSection new]
    set gentypes [DPTextSection new]
    $ctor gencode $gencode
    $ctor gentypes $gentypes

    # Generate default Delphi parameter for component constructor
    #
    if {[[$this ooplClass] isComponentClass] || [[$this ooplClass] isForm]} {
        set type [DPType new]
        $type name "TComponent"
        $type includeType "system"
        $type includeName "Classes"
        set param [DPArgument new $type]
        $param name "AOwner"
        $ctor addArg $param
    }

    # Generate initializers
    #
    set superctor [DPConstructor new]
    foreach initializer [$this superClassInitializerSet] {
        $initializer generate $superctor
    }

    # Generate key attribute initialization code
    #
    foreach initializer [$this attribInitializerSet] {
        $initializer generate $ctor
    }

    # Generate initialized data attribute values
    #
    foreach attrib [[$this ooplClass] dataAttrSet] {
        $attrib generateInitialValue $ctor $class
    }
    [$ctor gencode] append "\n"

    # Generate association initialization code
    #
    foreach initializer [$this assocInitializerSet] {
        $initializer generate $ctor
    }

    # Generate superclass call
    #
    $gencode append "inherited Create"
    if {[[$superctor argSet] contents] != "" || [[$this ooplClass] isForm] || [[$this ooplClass] isComponent] } {
        $gencode append "("
        set first 1
        if {[[$this ooplClass] isForm] || [[$this ooplClass] isComponent]} {
            $gencode append "AOwner"
            set first 0
        }
        [$superctor argSet] foreach arg {
            if {$first} {
                set first 0
            } else {
                $gencode append ", "
            }
            $gencode append [$arg name]
        }
        $gencode append ")"
    }
    $gencode append ";\n"


    # Generate parameters
    #
    foreach param [[$this ooplClass] creationParamSet] {
        if {![$param isGUIComponent [$this ooplClass]]} {
            $param generate $ctor
        }
    }

    $class constructr $ctor
}

# Do not delete this line -- regeneration end marker

if [isCommand CMConstructor] {
    Class  DPGConstructorD : {DPGConstructor CMConstructor} {
    }
} else {
    Class DPGConstructorD : {DPGConstructor OPConstructor} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPConstructor) DPGConstructorD

selfPromoter OPConstructor {this} {
    DPGConstructorD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)dpgoperati.tcl    /main/titanic/16


Class DPGOperation : {DPGFeature} {
    constructor
    method destructor
    method check
    method checkEvent
    method checkEventLocal
    method checkLocal
    method getBaseEvent
    method generateEvent
    method generate
    method findNrEvents
    method findNrMethods
    method isEvent
    attribute eventAccess
}

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

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

method DPGOperation::check {this} {
    set errornr [$this checkLocal]

    # Return type
    incr errornr [[$this ooplType] check]

    # Parameters
    foreach param [$this parameterSet] {
        $param check
    }

    return $errornr
}

method DPGOperation::checkEvent {this componentName} {
    set errornr [$this checkEventLocal $componentName]

    if {[[$this ooplClass] isGUIComponent]} {
        set super [[$this ooplClass] getSuperClass]
        set baseEvent [$this getBaseEvent $super]
        if {$baseEvent != ""} {
            foreach param [$baseEvent parameterSet] {
                incr errornr [$param check]
            }
        }
    }

    return $errornr
}

method DPGOperation::checkEventLocal {this componentName} {
    set errornr 0

    set eventname $componentName[$this getName]

    set tempmod [$this getPropertyValue "method_modifier"]
    if {[$this isClassFeature] || ( $tempmod != "" && $tempmod != "None" )} {
        m4_warning $W_EVTILLTYPE $eventname $componentName
    }

    if {[$this findNrEvents [string tolower $eventname]] > 1} {
        m4_error $E_EVTDBDEF $eventname $componentName
        incr errornr 1
    }

    # Check if event exists. For Dummy control classes, events only
    # exist if they have been declared Published

    if {[[$this ooplClass] isGUIComponent]} {
        set super [[$this ooplClass] getSuperClass]
        set baseEvent [$this getBaseEvent $super]
        if {$baseEvent == ""} {
            m4_error $E_EVTNOTEXIST [$this getName] $componentName
            incr errornr 1
        } else {
            if {[[$this ooplClass] isComponentDummy]} {
                if {[$baseEvent eventAccess] != "Published"} {
                    m4_error $E_EVTNOTPUBL [$this getName] $componentName
                    incr errornr 1
                }
            }
        }
    }

    return $errornr
}

method DPGOperation::checkLocal {this} {
    set errornr 0

    # No events for non-GUI classes
    #
    if {[$this isEvent]} {
        if {![[$this ooplClass] isGUIComponent]} {
            m4_error $E_CANTCONTEVENT [[$this ooplClass] getName] [$this getName]
            incr errornr 1
        }
    }
    # Check for duplicate names
    #
    # Note: exception for constructors, these are always named "create"
    #
    set opername [string tolower [$this getName]]
    if {!($opername == "create" && [$this isClassFeature])} {
        if {[$this findNrMethods $opername] > 1} {
            m4_error $E_METHDBDEF [$this getName] [[$this ooplClass] getName]
            incr errornr 1
        }
    }
    return $errornr
}

method DPGOperation::getBaseEvent {this class} {

    set event ""
    set eventAccess "None"

    # Find base Event with access "Published"
    set eventname [$this getName]
    while {[$class getSuperClass] != ""} {
        foreach operation [$class operationSet] {
            if {[$operation getName] == $eventname} {
                set access [$operation getPropertyValue "method_access"]
                if {$access == ""} {
                    set access "Public"
                }
                set event $operation

                if {$eventAccess != "Published"} {
                    set eventAccess $access
                }

                if {[llength [$operation parameterSet]] > 0} {
                    $event eventAccess $eventAccess
                    return $event
                }
            }
        }
        set class [$class getSuperClass]
    }
    if {$event != ""} {
        $event eventAccess $eventAccess
    }
    return $event
}

method DPGOperation::generateEvent {this class control} {

    if {[$this checkEventLocal [$control name]] > 0} {
        return ""
    }

    set event [DPEvent new]
    $event name [$control name][$this getName]

    $event component [$control name]
    $event compclass [[$this ooplClass] getName]

    # Add event to class

    $class addEvent $event

    # Search event

    if {[[$this ooplClass] isGUIComponent]} {
        set super [[$this ooplClass] getSuperClass]
        set baseEvent [$this getBaseEvent $super]

        # Generate parameters of base-event

        foreach param [$baseEvent parameterSet] {
            $param generate $event
        }
    }

    # Access

    $event access "Published"

    # Comment

    set comment [DPComment new]
    $event comment $comment
    $comment comment [$this getPropertyValue "freeText"]

    return $event
}

method DPGOperation::generate {this class} {
    if {[$this checkLocal] > 0} {
        return
    }

    # No events for non-GUI classes

    if {[$this isEvent]} {
        return
    }

    # Constructor

    if {[$this getName] == "create" && [$this isClassFeature]} {
        set oper [DPConstructor new]
        $oper name [$this getName]

        if {[[$this ooplClass] constructor] != ""} {
            set counted [[[$this ooplClass] constructor] counted]
            if {($counted == "") || ($counted == "0")} {
                [[$this ooplClass] constructor] counted 1
                $class userConstructors [expr [$class userConstructors] + 1]
            }
        }
        $class userConstructors [expr [$class userConstructors] + 1]
        if {[expr [$class userConstructors] > 1]} {
            $oper name [$oper name][$class userConstructors]
        }
    } else {

        # Procedure or function

        set returnType [[$this ooplType] generate]
        if {[$returnType name] != ""} {
            set oper [DPFunction new $returnType]
        } else {
            set oper [DPProcedure new]
        }
        $oper name [$this getName]
        $oper isClassFeature [$this isClassFeature]
    }

    # Add method to class

    $class addUsermethod $oper

    # Access

    $oper access [$this getPropertyValue "method_access"]
    if {[$oper access] == ""} {
        $oper access "Public"
    }

    # Comment

    set comment [DPComment new]
    $oper comment $comment
    $comment comment [$this getPropertyValue "freeText"]

    # Method calling

    $oper methodCalling [$this getPropertyValue "method_calling"]

    # Method modifier

    set modif [$this getPropertyValue "method_modifier"]

    if {($modif == "") || ($modif == "None")} {
        if {[$this isAbstract]} {
            $oper isAbstract 1
            $oper isVirtual 1
        }
    }

    switch $modif {
        "Virtual"    {
            $oper isVirtual 1
        }
        "Dynamic"    {
            $oper isDynamic 1
        }
        "Virtual Abstract"    {
            $oper isAbstract 1
            $oper isVirtual 1
        }
        "Dynamic Abstract"    {
            $oper isAbstract 1
            $oper isDynamic 1
        }
        "Override"    {
            $oper isOverride 1
        }
        default    {
        }
    }

    # Parameters

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

method DPGOperation::findNrEvents {this name} {
    set nr 0
    foreach feature [[$this ooplClass] operationSet] {
        if {[string tolower [$feature getName]] == $name && [$feature isEvent]} {
            incr nr 1
        }
    }
    return $nr
}

method DPGOperation::findNrMethods {this name} {
    set nr 0
    foreach feature [[$this ooplClass] operationSet] {
        if {[string tolower [$feature getName]] == $name} {
            incr nr 1
        }
    }
    return $nr
}

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

# Do not delete this line -- regeneration end marker

if [isCommand CMOperation] {
    Class  DPGOperationD : {DPGOperation CMOperation} {
    }
} else {
    Class DPGOperationD : {DPGOperation OPOperation} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPOperation) DPGOperationD

selfPromoter OPOperation {this} {
    DPGOperationD promote $this
}


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


Class DPGAssocInitializer : {DPGInitializer} {
    constructor
    method destructor
    method generate
}

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

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

method DPGAssocInitializer::generate {this ctor} {
    if {[[[$this assoc] ooplType] ooplClass] != ""} {
        if {[[[[$this assoc] ooplType] ooplClass] isComponent]} {
            return
        }
    }

    [$this assoc] setGenerator

    set typename [[[$this assoc] generator] typename]
    set varname [[[$this assoc] generator] varname]
    set varref [[[$this assoc] generator] varref]
    set varset [[[$this assoc] generator] varset]
    set vardict [[[$this assoc] generator] vardict]
    if {[[$this assoc] opposite] != ""} {
        set opvarname [[[$this assoc] generator] opvarname]
        set opvarref [[[$this assoc] generator] opvarref]
        set opvarset [[[$this assoc] generator] opvarset]
        set opvardict [[[$this assoc] generator] opvardict]
    }
    set varname "new${varname}"
    set castRefname [[[$this assoc] generator] castType $varref]

    # ToDo: Clean this up!!
    #
    set assoctype [[$this assoc] generateAssocType [[[$this constructor] ooplClass] target]]


    if {[[$this assoc] isMandatory]} {
        [$ctor gencode] append "if (${varname} <> NIL) then\nbegin\n"
        [$ctor gencode] indent +
    }
    if {[[$this assoc] getMultiplicity] == "one"} {
        if {[[$this assoc] isMandatory] &&
            [[$this assoc] opposite] != ""} {
            if {[[[$this assoc] opposite] isQualified]} {
                if {[[[$this assoc] opposite] get_obj_type] == "qual_link_attrib"} {
                    [$ctor gencode] append "${varref} := ${varname};\n"
                    set key [[[$this constructor] qualInitializer] getName]
                    if {[[[$this assoc] opposite] getMultiplicity] == "one"} {
                        [$ctor gencode] append "${castRefname}.${opvardict}.Add(${key}, SELF);\n"
                    } else {
                        set tempset "temp${opvarset}"
                        set manytype [[$this assoc] generateManyAssocType [[[$this constructor] ooplClass] target]]
                        [$ctor gentypes] append "var\n"
                        [$ctor gentypes] indent +
                        [$ctor gentypes] append "${tempset}: [$manytype name];\n"
                        [$ctor gentypes] indent -

                        [$ctor gencode] append "if (${castRefname}.${opvardict}.Item(${key}) <> NIL) then\nbegin\n"
                        [$ctor gencode] indent +
                        [$ctor gencode] append "${tempset} := ${castRefname}.${opvardict}.Item(${key});\n"
                        [$ctor gencode] indent -
                        [$ctor gencode] append "end\n"
                        [$ctor gencode] append "else\n"
                        [$ctor gencode] append "begin\n"
                        [$ctor gencode] indent +
                        [$ctor gencode] append "${tempset} := [$manytype name].Create;\n"
                        [$ctor gencode] append "${castRefname}.${opvardict}.Add(${key}, ${tempset})\n"
                        [$ctor gencode] indent -
                        [$ctor gencode] append "end;\n"
                        [$ctor gencode] append "${tempset}.Add(SELF);\n"
                    }
                } else {
                    m4_warning $W_NOCTORCODE [[[$this assoc] ooplClass] getName] [[[[$this assoc] opposite] ooplClass] getName]
                }
            } else {
                [$ctor gencode] append "${varref} := ${varname};\n"
                if {[[[$this assoc] opposite] getMultiplicity] == "one"} {
                    [$ctor gencode] append "${castRefname}.${opvarref} := SELF;\n"
                } else {
                    [$ctor gencode] append "${castRefname}.${opvarset}.Add(SELF);\n"
                }
            }
        } else {
            [$ctor gencode] append "${varref} := ${varname};\n"
        }
    } else {
        set manytype [[$this assoc] generateManyAssocType [[[$this constructor] ooplClass] target]]
        [$ctor gencode] append "${varset} := [$manytype name].Create;\n";
        [$ctor gencode] append "add[cap ${varname}](${varname});\n"
    }

    if {[[$this assoc] isMandatory]} {
        set sysutilstype [DPType new]
        $sysutilstype includeName "SysUtils"
        $sysutilstype includeType "imp"
        $sysutilstype addAsInclude [[[$this constructor] ooplClass] target]

        [$ctor gencode] indent -
        [$ctor gencode] append "end\nelse\n"
        [$ctor gencode] indent +
        [$ctor gencode] append "raise EInvalidOp.Create('Object ${varname} has mandatory relation. NIL object reference not allowed.');\n"
        [$ctor gencode] indent -
    }
}

# Do not delete this line -- regeneration end marker

if [isCommand CMAssocInitializer] {
    Class  DPGAssocInitializerD : {DPGAssocInitializer CMAssocInitializer} {
    }
} else {
    Class DPGAssocInitializerD : {DPGAssocInitializer OPAssocInitializer} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPAssocInitializer) DPGAssocInitializerD

selfPromoter OPAssocInitializer {this} {
    DPGAssocInitializerD promote $this
}


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


Class DPGAttribInitializer : {DPGInitializer} {
    constructor
    method destructor
    method checkLocal
    method generate
}

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

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

method DPGAttribInitializer::checkLocal {this} {
    set errornr 0
    if {[[$this attrib] isClassFeature]} {
        m4_warning $W_NOKEYFEAT [[$this attrib] getName] [[[$this attrib] ooplClass] getName]
        incr errornr 1
    }
    return $errornr
}

method DPGAttribInitializer::generate {this ctor} {
    if {[$this checkLocal] > 0} {
        return
    }
    [$ctor gencode] append "[[$this attrib] getName] := [$this getName];\n"
}

# Do not delete this line -- regeneration end marker

if [isCommand CMAttribInitializer] {
    Class  DPGAttribInitializerD : {DPGAttribInitializer CMAttribInitializer} {
    }
} else {
    Class DPGAttribInitializerD : {DPGAttribInitializer OPAttribInitializer} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPAttribInitializer) DPGAttribInitializerD

selfPromoter OPAttribInitializer {this} {
    DPGAttribInitializerD promote $this
}


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


Class DPGInhKeyInitializer : {DPGInitializer} {
    constructor
    method destructor
    method generate
}

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

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

method DPGInhKeyInitializer::generate {this ctor} {
    # !! Implement this function !!
}

# Do not delete this line -- regeneration end marker

if [isCommand CMInhKeyInitializer] {
    Class  DPGInhKeyInitializerD : {DPGInhKeyInitializer CMInhKeyInitializer} {
    }
} else {
    Class DPGInhKeyInitializerD : {DPGInhKeyInitializer OPInhKeyInitializer} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPInhKeyInitializer) DPGInhKeyInitializerD

selfPromoter OPInhKeyInitializer {this} {
    DPGInhKeyInitializerD promote $this
}


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


Class DPGQualInitializer : {DPGInitializer} {
    constructor
    method destructor
    method generate
}

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

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

method DPGQualInitializer::generate {this ctor} {
    # !! Implement this function !!
}

# Do not delete this line -- regeneration end marker

if [isCommand CMQualInitializer] {
    Class  DPGQualInitializerD : {DPGQualInitializer CMQualInitializer} {
    }
} else {
    Class DPGQualInitializerD : {DPGQualInitializer OPQualInitializer} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPQualInitializer) DPGQualInitializerD

selfPromoter OPQualInitializer {this} {
    DPGQualInitializerD promote $this
}


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


Class DPGSuperClassInitializer : {DPGInitializer} {
    constructor
    method destructor
    method generate
}

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

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

method DPGSuperClassInitializer::generate {this ctor} {
    foreach param [$this parameterSet] {
        if {![$param isGUIComponent [$this ooplClass]]} {
            $param generate $ctor
        }
    }
}

# Do not delete this line -- regeneration end marker

if [isCommand CMSuperClassInitializer] {
    Class  DPGSuperClassInitializerD : {DPGSuperClassInitializer CMSuperClassInitializer} {
    }
} else {
    Class DPGSuperClassInitializerD : {DPGSuperClassInitializer OPSuperClassInitializer} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPSuperClassInitializer) DPGSuperClassInitializerD

selfPromoter OPSuperClassInitializer {this} {
    DPGSuperClassInitializerD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)dpgctorpar.tcl    /main/titanic/9


Class DPGCtorParameter : {DPGParameter} {
    constructor
    method destructor
    method isGUIComponent
    method generate
}

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

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

method DPGCtorParameter::isGUIComponent {this class} {
    if {![$class isForm] && ![$class isComponent]} {
        return 0
    }
    set done 0
    while {!$done} {
        foreach assoc [$class genAssocAttrSet] {
            if {[$assoc getName] == [$this getName]} {
                if {[$assoc isAggregate]} {
                    if {[[$assoc ooplClass] isGUIComponent]} {
                        return 1
                    }
                }
            }
        }
        set class [$class getSuperClass]
        if {[$class getName] == "TForm" ||
            [$class getName] == "TDataModule" ||
            [$class getName] == "TComponent" ||
            [$class getName] == "TControl"} {
            set done 1
        }
    }
    return 0
}

method DPGCtorParameter::generate {this method} {

    if {[$this attrib] != ""} {
        if [[$this attrib] isClassFeature] {
            return
        }
    }

    # check if GUI association
    #
    if {[$this initializer] != ""} {
        if {[[$this initializer] isA OPAssocInitializer]} {
            if {[[[[$this initializer] assoc] ooplType] ooplClass] != ""} {
                if {[[[[[$this initializer] assoc] ooplType] ooplClass] isComponent]} {
                    return
                }
            }
        }
    }
    set param [DPArgument new [[$this ooplType] generateParamType]]
    $param name [$this getName]

    # check if association initializer parameter
    #
    if {[$this initializer] != ""} {
        if {[[$this initializer] isA OPAssocInitializer]} {
            $param name "new[$this getName]"
        } else {
            if {[[$this initializer] isA OPSuperClassInitializer]} {
                $param name "sc_[$this getName]"
            }
        }
    }

    $param passedBy [$this getPropertyValue "pass_by"]
    $method addArg $param
}

# Do not delete this line -- regeneration end marker

if [isCommand CMCtorParameter] {
    Class  DPGCtorParameterD : {DPGCtorParameter CMCtorParameter} {
    }
} else {
    Class DPGCtorParameterD : {DPGCtorParameter OPCtorParameter} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPCtorParameter) DPGCtorParameterD

selfPromoter OPCtorParameter {this} {
    DPGCtorParameterD promote $this
}


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


Class DPGOperParameter : {DPGParameter} {
    constructor
    method destructor
    method generate
}

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

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

method DPGOperParameter::generate {this method} {
    set param [DPArgument new [[$this ooplType] generateParamType]]
    $param name [$this getName]
    $param passedBy [$this getPropertyValue "pass_by"]
    $method addArg $param
}

# Do not delete this line -- regeneration end marker

if [isCommand CMOperParameter] {
    Class  DPGOperParameterD : {DPGOperParameter CMOperParameter} {
    }
} else {
    Class DPGOperParameterD : {DPGOperParameter OPOperParameter} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPOperParameter) DPGOperParameterD

selfPromoter OPOperParameter {this} {
    DPGOperParameterD promote $this
}


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


Class DPGBaseType : {DPGType} {
    constructor
    method destructor
    method generate
}

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

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

method DPGBaseType::generate {this} {
    set type [DPType new]
    $type name [$this getType3GL]
    $type includeType "none"
    $type includeName ""
    return $type
}

# Do not delete this line -- regeneration end marker

if [isCommand CMBaseType] {
    Class  DPGBaseTypeD : {DPGBaseType CMBaseType} {
    }
} else {
    Class DPGBaseTypeD : {DPGBaseType OPBaseType} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPBaseType) DPGBaseTypeD

selfPromoter OPBaseType {this} {
    DPGBaseTypeD promote $this
}


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


Class DPGClassType : {DPGType} {
    constructor
    method destructor
}

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

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

# Do not delete this line -- regeneration end marker

if [isCommand CMClassType] {
    Class  DPGClassTypeD : {DPGClassType CMClassType} {
    }
} else {
    Class DPGClassTypeD : {DPGClassType OPClassType} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPClassType) DPGClassTypeD

selfPromoter OPClassType {this} {
    DPGClassTypeD promote $this
}


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


Class DPGEnumType : {DPGType} {
    constructor
    method destructor
}

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

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

# Do not delete this line -- regeneration end marker

if [isCommand CMEnumType] {
    Class  DPGEnumTypeD : {DPGEnumType CMEnumType} {
    }
} else {
    Class DPGEnumTypeD : {DPGEnumType OPEnumType} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPEnumType) DPGEnumTypeD

selfPromoter OPEnumType {this} {
    DPGEnumTypeD promote $this
}


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


Class DPGTypeDefType : {DPGType} {
    constructor
    method destructor
}

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

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

# Do not delete this line -- regeneration end marker

if [isCommand CMTypeDefType] {
    Class  DPGTypeDefTypeD : {DPGTypeDefType CMTypeDefType} {
    }
} else {
    Class DPGTypeDefTypeD : {DPGTypeDefType OPTypeDefType} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPTypeDefType) DPGTypeDefTypeD

selfPromoter OPTypeDefType {this} {
    DPGTypeDefTypeD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)dpgassocma.tcl    /main/titanic/14


Class DPGAssocMany : {DPGAssocGen} {
    constructor
    method destructor
    method hasAdd
    method hasDtor
    method hasRemove
    method generate
    method generateAdd
    method generateGet
    method generateRemove
    method generateDtor
}

constructor DPGAssocMany {class this assocattr} {
    set this [DPGAssocGen::constructor $class $this $assocattr]
    # Start constructor user section
    # End constructor user section
    return $this
}

method DPGAssocMany::destructor {this} {
    # Start destructor user section
    # End destructor user section
    $this DPGAssocGen::destructor
}

method DPGAssocMany::hasAdd {this self} {
    set wr [$this propWrite]
    if {$self} {
        if {$wr == "None"} {
            return 0
        }
    } else {
        if {$wr == "None" || $wr == "Private" || $wr == "Protected"} {
            return 0
        }
    }
    if {[[$this assocattr] opposite] != ""} {
        if {[[[$this assocattr] opposite] isQualified]} {
            if {![$this addWarning]} {
                $this addWarning 1
                m4_warning $W_NOADD [[$this assocattr] getName] [[[$this assocattr] ooplClass] getName]
            }
            return 0
        }
    }
    return 1
}

method DPGAssocMany::hasDtor {this self} {
    if {[[$this assocattr] opposite] != ""} {
        if {[[[$this assocattr] opposite] isQualified]} {
            if {![$this dtorWarning]} {
                $this dtorWarning 1
                m4_warning $W_NODTOR [[$this assocattr] getName] [[[$this assocattr] ooplClass] getName]
            }
            return 0
        }
    }
    return 1
}

method DPGAssocMany::hasRemove {this self} {
    set wr [$this propWrite]
    if {$self} {
        if {$wr == "None"} {
            return 0
        }
    } else {
        if {$wr == "None" || $wr == "Private" || $wr == "Protected"} {
            return 0
        }
    }
    if {[[$this assocattr] opposite] != ""} {
        if {[[[$this assocattr] opposite] isMandatory] && [[[$this assocattr] opposite] getMultiplicity] == "one"} {
            return 0
        }
        if {[[[$this assocattr] opposite] isQualified]} {
            if {![$this removeWarning]} {
                $this removeWarning 1
                m4_warning $W_NOREMOVE [[$this assocattr] getName] [[[$this assocattr] ooplClass] getName]
            }
            return 0
        }
    }
    return 1
}

method DPGAssocMany::generate {this cl} {

    if {[$this checkLocal] > 0} {
            return
                }
    set manytype [[$this assocattr] generateManyAssocType $cl]
    set vari [DPVariable new $manytype]
    $vari name "[[$this assocattr] getName]Set"
    $cl addAssocvar $vari
    $vari access [$this propAccess]
    if {[$cl constructr] != ""} {
        [[$cl constructr] gencode] append "[$vari name] := [$manytype name].Create;\n"
    }
    if {[[$this assocattr] opposite] != ""} {
        [[$this assocattr] opposite] setGenerator
    }
    $this generateGet $vari $cl
    $this generateAdd $vari $cl
    $this generateRemove $vari $cl
    $this generateDtor $vari $cl
}

method DPGAssocMany::generateAdd {this vari cl} {
    # Check if Add method should be generated
    #
    if {![$this hasAdd 0]} {
        $vari access "Public"
    }
    if {![$this hasAdd 1]} {
        return
    }

    # Generate
    #
    set type [$this generateType $cl]
    set arg "new[$this typename]"
    set param [DPArgument new $type]
    $param name $arg
    set addproc [DPProcedure new]
    $addproc addArg $param
    set addcode [DPTextSection new]

    $addproc gencode $addcode
    $addproc hasUserSection 0
    $addproc access [$this propWrite]
    $addproc name "add[cap [$this varname]]"

    $addcode append "if ([$vari name].IndexOf(${arg}) = -1) then\nbegin\n"
    $addcode indent +
    $addcode append "[$vari name].Add(${arg});\n"

    if {[[$this assocattr] opposite] != ""} {
        if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {

            # many-many
            #
            if {[[[[$this assocattr] opposite] generator] hasAdd 0]} {
                $addcode append "[$this castType $arg].add[cap [$this opvarname]](SELF);\n"
            } else {
                $addcode append "[$this castType $arg].[$this opvarset].Add(SELF);\n"
            }
        } else {
            # one-many
            if {[[[[$this assocattr] opposite] generator] hasSet 0]} {
                $addcode append "[$this castType $arg].set[cap [$this opvarname]](SELF);\n"
            } else {
                $addcode append "[$this castType $arg].[$this opvarref] := SELF;\n"
            }
        }
    }

    $addcode indent -
    $addcode append "end;\n"

    $cl addAssocgenmethod $addproc
}

method DPGAssocMany::generateGet {this vari cl} {
    # Check if Get method should be generated
    #
    if {![$this hasGet 0]} {
        $vari access "Public"
    }
    if {![$this hasGet 1]} {
        return
    }

    # Generate
    #
    set type [[$this assocattr] generateManyAssocType $cl]
    set getproc [DPFunction new $type]
    set getcode [DPTextSection new]
    $getproc gencode $getcode
    $getproc hasUserSection 0
    $getproc access [$this propRead]
    $getproc name "get[cap [$this varname]]"
    $getcode append "[$getproc name] := "
    $getcode append "[$this varset];\n"
    $cl addAssocgenmethod $getproc
}

method DPGAssocMany::generateRemove {this vari cl} {
    # Check if Remove method should be generated
    #
    if {![$this hasRemove 0]} {
        $vari access "Public"
    }
    if {![$this hasRemove 1]} {
        return
    }

    # Generated
    #
    set removeproc [DPProcedure new]
    set type [$this generateType $cl]
    set arg "old[$this typename]"
    set param [DPArgument new $type]
    $param name $arg
    $removeproc addArg $param

    set removecode [DPTextSection new]
    $removeproc gencode $removecode
    $removeproc hasUserSection 0
    $removeproc access [$this propWrite]
    $removeproc name "remove[cap [$this varname]]"

    $removecode append "if ([$vari name].IndexOf(${arg}) <> -1) then\nbegin\n"
    $removecode indent +
    $removecode append "[$vari name].Remove(${arg});\n"

    if {[[$this assocattr] opposite] != ""} {
        if {[[[[$this assocattr] opposite] generator] hasRemove 0]} {
            $removecode append "[$this castType $arg].remove[cap [$this opvarname]]("
            if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {
                $removecode append "SELF"
            }
            $removecode append ");\n"
        } else {
            if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {
                $removecode append "[$this castType $arg].[$this opvarset].Remove(SELF);\n"
            } else {
                $removecode append "[$this castType $arg].[$this opvarref] := NIL;\n"
            }
        }
    }
    $removecode indent -
    $removecode append "end;\n"

    $cl addAssocgenmethod $removeproc
}

method DPGAssocMany::generateDtor {this vari cl} {

    # Check if Destructor should be generated
    #
    if {![$this hasDtor 1]} {
        [[$cl destructr] gencode] append "[$this varset].Destroy;\n"
        return
    }
    # Generate
    #

    if {[[$this assocattr] opposite] != ""} {
        if {[[[$this assocattr] opposite] isMandatory] && [[[$this assocattr] opposite] getMultiplicity] == "one"} {
            set sysutilstype [DPType new]
            $sysutilstype includeName "SysUtils"
            $sysutilstype includeType "imp"
            $sysutilstype addAsInclude [[[[[$this assocattr] opposite] ooplType] ooplClass] target]
            [[$cl destructr] gencode] append "if ([$this varset].Count <> 0) then\n"
            [[$cl destructr] gencode] indent +
            [[$cl destructr] gencode] append "raise EInvalidOp.Create('Illegal object destruction. Mandatory relation "
            [[$cl destructr] gencode] append "[$this varset] not empty.');\n"
            [[$cl destructr] gencode] indent -
            [[$cl destructr] gencode] append "[$this varset].Destroy;\n"
            return
        }

        [[$cl destructr] gencode] append "while ([$this varset].Count > 0) do\nbegin\n"
        [[$cl destructr] gencode] indent +
        if {[$this hasRemove 1]} {
            [[$cl destructr] gencode] append "remove[cap [$this varname]]([$this varset].First)\n"
        } else {
            set old "old[$this typename]"

            [[$cl destructr] gentypes] append "var\n"
            [[$cl destructr] gentypes] indent +
            [[$cl destructr] gentypes] append "${old}: [[$vari type] name];\n\n"
            [[$cl destructr] gentypes] indent -
            [[$cl destructr] gencode] append "${old} := [$this varset].First;\n"
            [[$cl destructr] gencode] append "[$this varset].Remove(${old});\n"
            if {[[[[$this assocattr] opposite] generator] hasRemove 0]} {
                [[$cl destructr] gencode] append "${old}.remove[cap [$this varname]];\n"
            } else {
                [[$cl destructr] gencode] append "${old}.[$this opvarname] := NIL;\n"
            }
        }

        [[$cl destructr] gencode] indent -
        [[$cl destructr] gencode] append "end;\n"
    }

    [[$cl destructr] gencode] append "[$this varset].Destroy;\n"
}

# Do not delete this line -- regeneration end marker



#---------------------------------------------------------------------------
#      File:           @(#)dpgassocon.tcl    /main/titanic/13


Class DPGAssocOne : {DPGAssocGen} {
    constructor
    method destructor
    method hasSet
    method hasDtor
    method hasRemove
    method generate
    method generateSet
    method generateGet
    method generateRemove
    method generateDtor
}

constructor DPGAssocOne {class this assocattr} {
    set this [DPGAssocGen::constructor $class $this $assocattr]
    # Start constructor user section
    # End constructor user section
    return $this
}

method DPGAssocOne::destructor {this} {
    # Start destructor user section
    # End destructor user section
    $this DPGAssocGen::destructor
}

method DPGAssocOne::hasSet {this self} {
    set wr [$this propWrite]
    if {$self} {
        if {$wr == "None"} {
                return 0
        }
    } else {
        if {$wr == "None" || $wr == "Private" || $wr == "Protected"} {
                return 0
        }
    }
    if {[[$this assocattr] opposite] != ""} {
        if {[[[$this assocattr] opposite] isMandatory] && [[[$this assocattr] opposite] getMultiplicity] == "one"} {
            return 0
        }
        if {[[[$this assocattr] opposite] isQualified]} {
            if {![$this setWarning]} {
                $this setWarning 1
                m4_warning $W_NOSET [[$this assocattr] getName] [[[$this assocattr] ooplClass] getName]
            }
            return 0
        }
    }
    return 1
}

method DPGAssocOne::hasDtor {this self} {
    if {[[$this assocattr] opposite] != ""} {
       if {[[[$this assocattr] opposite] isQualified] && [[[$this assocattr] opposite] getMultiplicity] != "one"} {
           if {![$this dtorWarning]} {
            $this dtorWarning 1
              m4_warning $W_NODTOR [[$this assocattr] getName] [[[$this assocattr] ooplClass] getName]
          }
          return 0
       }
    }
    return 1
}

method DPGAssocOne::hasRemove {this self} {
    set wr [$this propWrite]
    if {$self} {
            if {$wr == "None"} {
                    return 0
            }
    } else {
            if {$wr == "None" || $wr == "Private" || $wr == "Protected"} {
                    return 0
            }
    }
    if {[[$this assocattr] opposite] != ""} {
       if {[[[$this assocattr] opposite] isMandatory] && [[[$this assocattr] opposite] getMultiplicity] == "one"} {
          return 0
       }
       if {[[[$this assocattr] opposite] isQualified]} {
               if {![$this removeWarning]} {
                $this removeWarning 1
              m4_warning $W_NOREMOVE [[$this assocattr] getName] [[[$this assocattr] ooplClass] getName]
              }
          return 0
       }
    }
    if {[[$this assocattr] isMandatory]} {
       return 0
    }
    return 1
}



method DPGAssocOne::generate {this cl} {

    if {[$this checkLocal] > 0} {
        return
    }

    set type [$this generateType $cl]
    set vari [DPVariable new $type]
    $vari name [$this varref]
    $cl addAssocvar $vari
    $vari access [$this propAccess]

    if {[[$this assocattr] opposite] != ""} {
        [[$this assocattr] opposite] setGenerator
    }
    $this generateGet $vari $cl
    $this generateSet $vari $cl
    $this generateRemove $vari $cl
    $this generateDtor $vari $cl
}

method DPGAssocOne::generateSet {this vari cl} {

    # Check if Set method should be generated
    #
    if {![$this hasSet 0]} {
        $vari access "Public"
    }
    if {![$this hasSet 1]} {
        return
    }

    # Generate
    #
    set type [$this generateType $cl]

    set arg "new[$this typename]"
    set param [DPArgument new $type]
    $param name $arg
    set setproc [DPProcedure new]
    $setproc addArg $param
    set setcode [DPTextSection new]

    $setproc gencode $setcode
    $setproc hasUserSection 0
    $setproc access [$this propWrite]
    $setproc name "set[cap [$this varname]]"
    if {[[$this assocattr] opposite] != ""} {
        $setcode append "if (${arg} <> NIL) then\nbegin\n"
        $setcode indent +

        if {[[$this assocattr] isMandatory]} {
            if {[[[$this assocattr] opposite] getMultiplicity] == "one"} {
                # one-mtory
                #
                if {[[[[$this assocattr] opposite] generator] hasGet 0]} {
                    $setcode append "if ([$this castType $arg].get[cap [$this opvarname]] = NIL) then\nbegin\n"
                } else {
                    $setcode append "if ([$this castType $arg].[$this opvarref] = NIL) then\nbegin\n"
                }
                $setcode indent +
                $setcode append "[$this castType [$vari name]].[$this opvarref] := NIL;\n"
            } else {
                # many-mtory
                #
                $setcode append "if (${arg} <> [$vari name]) then\nbegin\n"
                $setcode indent +
                $setcode append "if ([$vari name] <> NIL) then\nbegin\n"
                $setcode indent +
                $setcode append "[$this castType [$vari name]].[$this opvarset].Remove(SELF);\n"
                $setcode indent -
                $setcode append "end;\n"
            }
        } else {

            # one/many - one
            #
            $setcode append "if (${arg} <> [$vari name]) then\nbegin\n"
            $setcode indent +
            $setcode append "if ([$vari name] <> NIL) then\nbegin\n"
            $setcode indent +
            if {[[[[$this assocattr] opposite] generator] hasRemove 0]} {
                $setcode append "[$this castType [$vari name]].remove[cap [$this opvarname]]"
                if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {
                    $setcode append "(SELF)"
                }
            } else {
                if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {
                    $setcode append "[$this castType [$vari name]].[$this opvarset].Remove(SELF)"
                } else {
                    $setcode append "[$this castType [$vari name]].[$this opvarref] := NIL"
                }
            }

            $setcode append ";\n"
            $setcode indent -
            $setcode append "end;\n"
        }

        $setcode append "[$vari name] := ${arg};\n"

        if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {

            # many - one/mtory
            #
            if {[[[[$this assocattr] opposite] generator] hasAdd 0]} {
                $setcode append "[$this castType $arg].add[cap [$this opvarname]](SELF);\n"
            } else {
                $setcode append "[$this castType $arg].[$this opvarset].Add(SELF);\n"
            }
        } else {
            # one - one/mtory
            #
            if {[[[[$this assocattr] opposite] generator] hasSet 0]} {
                $setcode append "[$this castType $arg].set[cap [$this opvarname]](SELF);\n"
            } else {
                $setcode append "[$this castType $arg].[$this opvarref] := SELF;\n"
            }
        }
        $setcode indent -
        $setcode append "end;\n"

        if {[$this hasRemove 1]} {
            # one/many - one
            #
            $setcode indent -
            $setcode append "end\nelse\nbegin\n"
            $setcode indent +
            $setcode append "remove[cap [$this varname]];\n"
        }
        $setcode indent -
        $setcode append "end;\n"

    } else {
        if {[[$this assocattr] isMandatory]} {
            $setcode append "if (${arg} <> NIL) then\nbegin\n"
            $setcode indent +
            $setcode append "[$this varref] := ${arg};\n"
            $setcode indent -
            $setcode append "end;\n"
        } else {
            $setcode append "[$this varref] := ${arg};\n"
        }
    }
    $cl addAssocgenmethod $setproc
}

method DPGAssocOne::generateGet {this vari cl} {
    # Check if Get method should be generated
    #
    if {![$this hasGet 0]} {
        $vari access "Public"
    }
    if {![$this hasGet 1]} {
        return
    }

    # Generate
    #
    set type [$this generateType $cl]
    set getproc [DPFunction new $type]
    set getcode [DPTextSection new]
    $getproc gencode $getcode
    $getproc hasUserSection 0
    $getproc access [$this propRead]
    $getproc name  "get[cap [$this varname]]"
    $getcode append "[$getproc name] := [$vari name];\n"
    $cl addAssocgenmethod $getproc
}

method DPGAssocOne::generateRemove {this vari cl} {
    # Check if remove method should be generated
    #
    if {![$this hasRemove 0]} {
        $vari access "Public"
    }
    if {![$this hasRemove 1]} {
        return
    }

    # Generate
    #
    set removeproc [DPProcedure new]
    set removecode [DPTextSection new]
    set removetypes [DPTextSection new]

    set old "old[$this typename]"
    $removeproc gencode $removecode
    $removeproc gentypes $removetypes
    $removeproc hasUserSection 0
    $removeproc access [$this propWrite]
    $removeproc name "remove[cap [$this varname]]"

    if {[[$this assocattr] opposite] != ""} {
        $removecode append "if ([$vari name] <> NIL) then\nbegin\n"
        $removecode indent +
        $removetypes append "var\n"
        $removetypes indent +
        $removetypes append "${old}: [$this typename];\n\n"
        $removetypes indent -
        $removecode append "${old} := [$vari name];\n"
        $removecode append "[$vari name] := NIL;\n"

        if {[[[[$this assocattr] opposite] generator] hasRemove 0]} {

            # Use remove method
            #
            $removecode append "${old}.remove[cap [$this opvarname]]("
            if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {
                $removecode append "SELF"
            }
            $removecode append ");\n"
        } else {

            # Use direct access
            #
            if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {
                $removecode append "${old}.[$this opvarset].Remove(SELF);\n"
            } else {
                $removecode append "${old}.[$this opvarref] := NIL;\n"
            }
        }
        $removecode indent -
        $removecode append "end;\n"
    } else {
        $removecode append "[$vari name] := NIL;\n"
    }
    $cl addAssocgenmethod $removeproc
}

method DPGAssocOne::generateDtor {this vari cl} {

    # Check if Destructor should be generated
    #
    if {![$this hasDtor 1]} {
        return
    }

    # Generate
    #
    if {[[$this assocattr] opposite] != ""} {
        if {[[[$this assocattr] opposite] isMandatory] && [[[$this assocattr] opposite] getMultiplicity] == "one"} {
            set sysutilstype [DPType new]
            $sysutilstype includeName "SysUtils"
            $sysutilstype includeType "imp"
            $sysutilstype addAsInclude [[[[[$this assocattr] opposite] ooplType] ooplClass] target]
            [[$cl destructr] gencode] append "if ([$this varref] <> NIL) then\n"
            [[$cl destructr] gencode] indent +
            [[$cl destructr] gencode] append "raise EInvalidOp.Create('Illegal object destruction. Object [$this varname] "
            [[$cl destructr] gencode] append "with mandatory relation exists.');\n"
            [[$cl destructr] gencode] indent -
            return
        }
        if {[$this hasRemove 1]} {
            [[$cl destructr] gencode] append "remove[cap [$this varname]];\n"
        } else {
            if {![[[$this assocattr] opposite] isQualified]} {
                if {[[[[$this assocattr] opposite] generator] hasRemove 0]} {
                    if {[[[$this assocattr] opposite] getMultiplicity] == "one"} {
                        [[$cl destructr] gencode] append "[$this castType [$this varref]].remove[cap [$this opvarname]];\n"
                    } else {
                        [[$cl destructr] gencode] append "[$this castType [$this varset]].remove[cap [$this opvarname]](SELF);\n"
                    }
                } else {
                    if {[[[$this assocattr] opposite] getMultiplicity] == "one"} {
                        [[$cl destructr] gencode] append "[$this castType [$this varref]].[$this opvarref] := NIL;\n"
                    } else {
                        [[$cl destructr] gencode] append "[$this castType [$this varref]].[$this opvarset].Remove(SELF);\n"
                    }
                }
            }
        }
    }
}

# Do not delete this line -- regeneration end marker



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


Class DPGQual : {DPGAssocGen} {
    constructor
    method destructor
    method hasAdd
    method hasDtor
    method hasRemove
}

constructor DPGQual {class this assocattr} {
    set this [DPGAssocGen::constructor $class $this $assocattr]
    # Start constructor user section
    # End constructor user section
    return $this
}

method DPGQual::destructor {this} {
    # Start destructor user section
    # End destructor user section
    $this DPGAssocGen::destructor
}

method DPGQual::hasAdd {this self} {
    set wr [$this propWrite]
    if {$self} {
        if {$wr == "None"} {
            return 0
        }
    } else {
        if {$wr == "None" || $wr == "Private" || $wr == "Protected"} {
            return 0
        }
    }
    return 1
}

method DPGQual::hasDtor {this self} {
#    if {[[$this assocattr] opposite] != ""} {
#        if {[[[$this assocattr] opposite] isMandatory] && [[[$this assocattr] opposite] getMultiplicity] == "one"} {
#            return 0
#        }
#    }
    return 1
}

method DPGQual::hasRemove {this self} {
    set wr [$this propWrite]
    if {$self} {
    } else {
        if {$wr == "None" || $wr == "Private" || $wr == "Protected"} {
            return 0
        }
    }
    if {[[$this assocattr] opposite] != ""} {
        if {[[[$this assocattr] opposite] isMandatory] && [[[$this assocattr] opposite] getMultiplicity] == "one"} {
            return 0
        }
    }
    return 1
}

# Do not delete this line -- regeneration end marker



#---------------------------------------------------------------------------
#      File:           @(#)dpgdataatt.tcl    /main/titanic/14


Class DPGDataAttr : {DPGAttribute} {
    constructor
    method destructor
    method check
    method checkLocal
    method findNrAttribs
    method generateInitialValue
    method generateAccessors
    method generate
    method isProperty
}

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

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

method DPGDataAttr::check {this} {
    set errornr [$this checkLocal]

    [$this ooplType] check

    return $errornr
}

method DPGDataAttr::checkLocal {this} {
    set errornr 0
    set classtype [[$this ooplClass] getClassType]
    set accessList [split [$this getPropertyValue "attrib_access"] -]
    set readAccess [lindex $accessList 0]
    set writeAccess [lindex $accessList 1]

    # Type modifiers only allowed for:
    # - Typedefs
    # - Records
    # - Classes without access methods to this attribute
    #
    set error 0
    if {[[$this ooplType] getAttribTypeModifier] != ""} {
        if {[[$this ooplClass] get_obj_type] != "class_typedef"} {
            if {$classtype != "Record"} {
                if {$classtype == "Class"} {
                    if {$readAccess != "None" || $writeAccess != "None"} {
                        set error 1
                    }
                } else {
                    set error 1
                }
            }
        }
    }
    if {$error} {
        incr errornr 1
        m4_error $E_ATTRTYPEMOD [$this getName] [[$this ooplClass] getName]
    }

    # Check property
    #
    set error 0
    if {[$this isProperty]} {
        if {[[$this ooplClass] get_obj_type] != "class"} {
            set error 1
        } else {
            if {($classtype != "Class") && ($classtype != "Interface")} {
                set error 1
            }
        }
    }
    if {$error} {
        incr errornr 1
        m4_error $E_NOPROPS [[$this ooplClass] getName]
    }

    # Check for double defined
    #
    set attrname [string tolower [$this getName]]
    if {[$this findNrAttribs $attrname] > 1} {
        m4_error $E_ATTRDBDEF [$this getName] [[$this ooplClass] getName]
        incr errornr 1
    }

    # Check for enum type
    #
    if {[[$this ooplClass] get_obj_type] != "class_enum"} {
        if {[[$this ooplType] getName] == "enum"} {
            m4_error $E_NOENUM [[$this ooplClass] getName] [$this getName]
            incr errornr 1
        }
    }

    # Check for typedef type
    #
    if {[[$this ooplClass] get_obj_type] != "class_typedef"} {
        if {[$this getName] == "_"} {
            m4_error $E_CANTCONTTDEF [[$this ooplClass] getName]
            incr errornr 1
        }
    }

    return $errornr
}

method DPGDataAttr::findNrAttribs {this name} {
    set nr 0
    foreach feature [[$this ooplClass] dataAttrSet] {
        if {[string tolower [$feature getName]] == $name} {
            incr nr 1
        }
    }
    return $nr
}

method DPGDataAttr::generateInitialValue {this method class} {
    if {[$this getInitialValue] == ""} {
        return
    }
    if {[$this isClassFeature]} {
        [$method gencode] append "[$class name]_[$this getName]"
    } else {
        [$method gencode] append "[$this getName]"
    }
    [$method gencode] append " := [$this getInitialValue];\n"
}

method DPGDataAttr::generateAccessors {this class var name} {

    # acquire access settings

    set accessTxt [$this getPropertyValue "attrib_access"]
    set accessList [split $accessTxt -]
    set readAccess [lindex $accessList 0]
    if {$readAccess == ""} {
        set readAccess "Public"
    }
    set writeAccess [lindex $accessList 1]
    if {$writeAccess == ""} {
        set writeAccess "Public"
    }

    # create get function

    if {$readAccess != "None"} {
        set getname "get[cap $name]"
        set getmethod [DPFunction new [[$this ooplType] generate]]
        set getcode [DPTextSection new]

        $getmethod gencode $getcode
        $getmethod access $readAccess
        $getmethod name $getname

        $getcode append "[$getmethod name] := [$var name];\n"
        $class addGenmethod $getmethod
    }

    #create set procedure

    if {$writeAccess != "None"} {
        set setname "set[cap $name]"
        set setmethod [DPProcedure new]
        set setcode [DPTextSection new]
        $setmethod gencode $setcode
        $setmethod access $writeAccess
        $setmethod name $setname

        set arg [DPArgument new [[$this ooplType] generate]]
        $arg name "new[cap $name]"
        $setmethod addArg $arg

        $setcode append "[$var name] := [$arg name];\n"
        $class addGenmethod $setmethod
    }
}

method DPGDataAttr::generate {this class} {

    if {[$this checkLocal] > 0} {
        return
    }

    #
    # Property?
    #
    if {[$this isProperty]} {
        set property [DPProperty new [[$this ooplType] generateAttribType]]
        set comment [DPComment new]
        $property comment $comment
        $property name [$this getName]
        $comment comment [$this getPropertyValue "freeText"]

        $property index [$this getPropertyValue "prop_index"]
        $property usedefault [$this getPropertyValue "prop_usedefault"]
        $property default [$this getPropertyValue "prop_default"]
        $property read [$this getPropertyValue "prop_read"]
        $property write [$this getPropertyValue "prop_write"]
        $property storage [$this getPropertyValue "prop_stored"]
        $class addProperty $property
        return
    }

    set variable [DPVariable new [[$this ooplType] generateAttribType]]
    set comment [DPComment new]
    $variable comment $comment
    $variable name [$this getName]
    $comment comment [$this getPropertyValue "freeText"]

    #
    # Record attribute?
    #
    if {[$class unitType] == "record"} {
        $class addField $variable
        return
    }

    $variable isClassFeature [$this isClassFeature]
    $variable initvalue [$this getInitialValue]
    if {[$this isClassFeature]} {
        $variable name "[$class name]_[$this getName]"
        $variable access "Public"
        $class addGlobvar $variable
    } else {
        $variable access [$this getPropertyValue "attrib_visibility"]
        if {[$variable access] == ""} {
            $variable access "Private"
        }
        $class addUservar $variable
    }
    $this generateAccessors $class $variable [$this getName]
}

method DPGDataAttr::isProperty {this} {
    if {[$this getPropertyValue "is_prop"] == "1"} {
        return 1
    } else {
        return 0
    }
}

# Do not delete this line -- regeneration end marker

if [isCommand CMDataAttr] {
    Class  DPGDataAttrD : {DPGDataAttr CMDataAttr} {
    }
} else {
    Class DPGDataAttrD : {DPGDataAttr OPDataAttr} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPDataAttr) DPGDataAttrD

selfPromoter OPDataAttr {this} {
    DPGDataAttrD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)dpggenasso.tcl    /main/titanic/13


Class DPGGenAssocAttr : {DPGAttribute} {
    constructor
    method destructor
    method getName
    method hasGUIComponent
    method generateAssocType
    method generateQualAssocType
    method generateManyAssocType
    method generateComponent
    method check
    method checkComponent
    method checkLocal
    method generator
    attribute _generator
}

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

method DPGGenAssocAttr::destructor {this} {
    set ref [$this _generator]
    if {$ref != ""} {
        $ref _assocattr ""
    }
    # Start destructor user section
    # End destructor user section
}

method DPGGenAssocAttr::getName {this} {
    if {[$this isLinkAttr]} {
        if {[$this opposite] != ""} {
            return "[uncap [[[$this opposite] ooplClass] getName]]of[$this OPGenAssocAttr::getName]"
        }
    }
    return [$this OPGenAssocAttr::getName]
}

method DPGGenAssocAttr::hasGUIComponent {this} {
    if {![$this isAggregate]} {
        return 0
    }
    if {[[[$this ooplType] ooplClass] isComponent] &&
            [[[$this ooplType] ooplClass] getPropertyValue "is_declaration"] != 1} {
        if {[[[$this ooplType] ooplClass] isControl]} {
            return 2
        } else {
            return 1
        }
    } else {
        return 0
    }
}

method DPGGenAssocAttr::generateAssocType {this unit} {
    set type [[[$this ooplType] ooplClass] generateType]
    $type includeType "imp"
    $type addAsInclude $unit
    return $type
}

method DPGGenAssocAttr::generateQualAssocType {this unit} {
    set type [DPType new]
    $type name "TClassDict"
    $type includeType "system"
    $type includeName "ClassDict"
    $type addAsInclude $unit
    return $type
}

method DPGGenAssocAttr::generateManyAssocType {this unit} {
    set type [DPType new]
    $type name "TList"
    $type includeType "system"
    $type includeName "Classes"
    $type addAsInclude $unit
    return $type
}

method DPGGenAssocAttr::generateComponent {this class control} {
    [[$this ooplType] ooplClass] generateComponent [$this getName] $class $control
}

method DPGGenAssocAttr::check {this} {
    set errornr [$this checkLocal]

    return $errornr
}

method DPGGenAssocAttr::checkComponent {this form} {
    set errornr 0
    incr errornr [[[$this ooplType] ooplClass] checkComponent [$this getName] $form]
    return $errornr
}

method DPGGenAssocAttr::checkLocal {this} {
    set errornr 0

    return $errornr
}

# Do not delete this line -- regeneration end marker

if [isCommand CMGenAssocAttr] {
    Class  DPGGenAssocAttrD : {DPGGenAssocAttr CMGenAssocAttr} {
    }
} else {
    Class DPGGenAssocAttrD : {DPGGenAssocAttr OPGenAssocAttr} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPGenAssocAttr) DPGGenAssocAttrD

selfPromoter OPGenAssocAttr {this} {
    DPGGenAssocAttrD promote $this
}
method DPGGenAssocAttr::generator {this args} {
    if {$args == ""} {
        return [$this _generator]
    }
    set ref [$this _generator]
    if {$ref != ""} {
        $ref _assocattr ""
    }
    set obj [lindex $args 0]
    if {$obj != ""} {
        $obj _assocattr $this
    }
    $this _generator $obj
}



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


Class DPGManyQual : {DPGQual} {
    constructor
    method destructor
    method generate
    method generateAdd
    method generateGet
    method generateRemove
    method generateDtor
}

constructor DPGManyQual {class this assocattr} {
    set this [DPGQual::constructor $class $this $assocattr]
    # Start constructor user section
    # End constructor user section
    return $this
}

method DPGManyQual::destructor {this} {
    # Start destructor user section
    # End destructor user section
    $this DPGQual::destructor
}

method DPGManyQual::generate {this cl} {

    if {[$this checkLocal] > 0} {
            return
    }
    set qualtype [[$this assocattr] generateQualAssocType $cl]
    set vari [DPVariable new $qualtype]
    $vari name "[$this vardict]"
    $cl addAssocvar $vari
    $vari access [$this propAccess]
    if {[$cl constructr] != ""} {
        [[$cl constructr] gencode] append "[$vari name] := [$qualtype name].Create;\n"
    }
    if {[[$this assocattr] opposite] != ""} {
        [[$this assocattr] opposite] setGenerator
    }
    $this generateGet $vari $cl
    $this generateAdd $vari $cl
    $this generateRemove $vari $cl
    $this generateDtor $vari $cl
}

method DPGManyQual::generateAdd {this vari cl} {

    # Check if Add method should be generated
    #
    if {![$this hasAdd 0]} {
        $vari access "Public"
    }
    if {![$this hasAdd 1]} {
        return
    }

    # Generate
    #
    set argtype [$this generateType $cl]
    set manytype [[$this assocattr] generateManyAssocType $cl]
    set param [DPArgument new $argtype]

    set arg "new[$this typename]"
    $param name "${arg}"
    set addproc [DPProcedure new]
    set keyargtype [DPType new]
    $keyargtype name [[[[$this assocattr] qualifier] ooplType] getType3GL]
    set keyparam [DPArgument new $keyargtype]
    $keyparam name [$this varqual]
    $addproc addArg $keyparam
    $addproc addArg $param
    set addcode [DPTextSection new]
    set addtypes [DPTextSection new]

    $addproc gencode $addcode
    $addproc gentypes $addtypes
    $addproc hasUserSection 0
    $addproc access [$this propWrite]
    $addproc name "add[cap [$this varname]]"

    set tempset "temp[$this varset]"
    $addtypes append "var\n"
    $addtypes indent +
    $addtypes append "${tempset}: [$manytype name];\n"
    $addtypes indent -

    if {[[$this assocattr] opposite] != ""} {
        if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {
            $addcode append "[$this castType $arg].[$this opvarset].Add(SELF);\n"
        } else {
            $addcode append "[$this castType $arg].[$this opvarref] := SELF;\n"
        }
    }
    $addcode append "if ([$vari name].Item([$this varqual]) <> NIL) then\nbegin\n"
    $addcode indent +
    $addcode append "${tempset} := [$vari name].Item([$this varqual]);\n"
    $addcode indent -
    $addcode append "end\n"
    $addcode append "else\n"
    $addcode append "begin\n"
    $addcode indent +
    $addcode append "${tempset} := [$manytype name].Create;\n"
    $addcode append "[$vari name].Add([$this varqual], ${tempset})\n"
    $addcode indent -
    $addcode append "end;\n"
    $addcode append "${tempset}.Add(${arg});\n"

    $cl addAssocgenmethod $addproc
}

method DPGManyQual::generateGet {this vari cl} {
    # Check if Get method should be generated
    #
    if {![$this hasGet 0]} {
        $vari access "Public"
    }
    if {![$this hasGet 1]} {
        return
    }

    # Generate
    #
    set manytype [[$this assocattr] generateManyAssocType $cl]
    set getproc [DPFunction new $manytype]
    set getcode [DPTextSection new]
    $getproc gencode $getcode
    $getproc hasUserSection 0
    $getproc access [$this propRead]
    $getproc name "get[cap [$this varname]]"
    $getcode append "[$getproc name] := [$this vardict].Item([$this varqual]);\n"

    set argtype [DPType new]
    $argtype name [[[[$this assocattr] qualifier] ooplType] getType3GL]
    set arg [DPArgument new $argtype]
    $arg name [$this varqual]
    $getproc addArg $arg
    $cl addAssocgenmethod $getproc
}

method DPGManyQual::generateRemove {this vari cl} {
    # Check if method should be generated
    #
    if {![$this hasRemove 0]} {
        $vari access "Public"
    }
    if {![$this hasRemove 1]} {
        return
    }

    # Generate
    #
    set removeproc [DPProcedure new]
    set keyargtype [DPType new]
    $keyargtype name [[[[$this assocattr] qualifier] ooplType] getType3GL]
    set param [DPArgument new $keyargtype]
    $param name [$this varqual]
    $removeproc addArg $param

    set argtype [$this generateType $cl]
    set manytype [[$this assocattr] generateManyAssocType $cl]
    set arg "old[$this typename]"
    set param [DPArgument new $argtype]
    $param name $arg

    $removeproc addArg $param
    set removecode [DPTextSection new]
    set removetypes [DPTextSection new]
    set tempset "temp[$this varset]"
    $removeproc gencode $removecode
    $removeproc gentypes $removetypes
    $removeproc hasUserSection 0
    $removeproc name "remove[cap [[$this assocattr] getName]]"

    if {[$this propWrite] == "None"} {
        $removeproc access "Private"
        m4_warning $W_CHANGEDREM [[$this assocattr] getName] [[[$this assocattr] ooplClass] getName]
    } else {
        $removeproc access [$this propWrite]
    }

    $removetypes append "var\n"
    $removetypes indent +
    $removetypes append "${tempset}: [$manytype name];\n"
    $removetypes indent -
    $removecode append "${tempset} := [$vari name].Item([$this varqual]);\n"

    $removecode append "if ${tempset} <> NIL then\nbegin\n"
    $removecode indent +

    if {[[$this assocattr] opposite] != ""} {
        if {[[[$this assocattr] opposite] getMultiplicity] == "one"} {
            $removecode append "[$this castType $arg].[$this opvarref] := NIL;\n"
        } else {
            $removecode append "[$this castType $arg].[$this opvarset].Remove(SELF);\n"
        }
    }

    $removecode append "${tempset}.Remove(${arg});\n"

    if {![[$this assocattr] isMandatory]} {
       $removecode append "if (${tempset}.Count = 0) then\nbegin\n"
       $removecode indent +
       $removecode append "[$vari name].RemoveUsingKey([$this varqual]);\n"
       $removecode indent -
       $removecode append "end;\n"
    }

    $removecode indent -
    $removecode append "end;\n"
    $cl addAssocgenmethod $removeproc
}

method DPGManyQual::generateDtor {this vari cl} {

    # Check if Destructor should be generated
    #
    if {![$this hasDtor 1]} {
        [[$cl destructr] gencode] append "[$this vardict].Destroy;\n"
        return
    }

    # Generate
    #
    if {[[$this assocattr] opposite] != ""} {
        if {[[[$this assocattr] opposite] isMandatory] && [[[$this assocattr] opposite] getMultiplicity] == "one"} {
            set sysutilstype [DPType new]
            $sysutilstype includeName "SysUtils"
            $sysutilstype includeType "imp"
            $sysutilstype addAsInclude [[[[[$this assocattr] opposite] ooplType] ooplClass] target]

            [[$cl destructr] gencode] append "if ([$this vardict].Count <> 0) then\n"
            [[$cl destructr] gencode] indent +
            [[$cl destructr] gencode] append "raise EInvalidOp.Create('Illegal object destruction. Mandatory relation "
            [[$cl destructr] gencode] append "[[$this assocattr] getName]Set not empty.');\n"
            [[$cl destructr] gencode] indent -
        } else {
            set manytype [[$this assocattr] generateManyAssocType $cl]
            [[$cl destructr] gentypes] append "var\n"
            [[$cl destructr] gentypes] indent +
            [[$cl destructr] gentypes] append "tmp[$this varset]: [$manytype name];\n"
            [[$cl destructr] gentypes] append "tmp[$this varname]: [$this typename];\n"
            [[$cl destructr] gentypes] indent -
            [[$cl destructr] gencode] append "while ([$this vardict].Count <> 0) do\nbegin\n"
            [[$cl destructr] gencode] indent +
            [[$cl destructr] gencode] append "tmp[$this varset] := [$this vardict].First;\n"
            [[$cl destructr] gencode] append "while (tmp[$this varset].Count > 0) do\nbegin\n"
            [[$cl destructr] gencode] indent +
            [[$cl destructr] gencode] append "tmp[$this varname] := tmp[$this varset].First;\n"

            if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {
                [[$cl destructr] gencode] append "tmp[$this varname].[$this opvarset].Remove(SELF);\n"
            } else {
                [[$cl destructr] gencode] append "tmp[$this varname].[$this opvarref] := NIL;\n"
            }
            [[$cl destructr] gencode] append "tmp[$this varset].Remove(tmp[$this varname]);\n"
            [[$cl destructr] gencode] indent -
            [[$cl destructr] gencode] append "end;\n"
            [[$cl destructr] gencode] append "[$this vardict].Remove(tmp[$this varset]);\n"
            [[$cl destructr] gencode] indent -
            [[$cl destructr] gencode] append "end;\n"
        }
    }

    [[$cl destructr] gencode] append "[$this vardict].Destroy;\n"
}

# Do not delete this line -- regeneration end marker



#---------------------------------------------------------------------------
#      File:           @(#)dpgonequal.tcl    /main/titanic/14


Class DPGOneQual : {DPGQual} {
    constructor
    method destructor
    method generate
    method generateSet
    method generateGet
    method generateRemove
    method generateDtor
}

constructor DPGOneQual {class this assocattr} {
    set this [DPGQual::constructor $class $this $assocattr]
    # Start constructor user section
    # End constructor user section
    return $this
}

method DPGOneQual::destructor {this} {
    # Start destructor user section
    # End destructor user section
    $this DPGQual::destructor
}

method DPGOneQual::generate {this cl} {

    if {[$this checkLocal] > 0} {
            return
    }
    set qualtype [[$this assocattr] generateQualAssocType $cl]
    set vari [DPVariable new $qualtype]
    $vari name "[$this vardict]"
    $cl addAssocvar $vari
    $vari access [$this propAccess]
    if {[$cl constructr] != ""} {
        [[$cl constructr] gencode] append "[$vari name] := [$qualtype name].Create;\n"
    }
    if {[[$this assocattr] opposite] != ""} {
        [[$this assocattr] opposite] setGenerator
    }
    $this generateGet $vari $cl
    $this generateSet $vari $cl
    $this generateRemove $vari $cl
    $this generateDtor $vari $cl
}

method DPGOneQual::generateSet {this vari cl} {
    # Check if Set method should be generated
    #
    if {![$this hasAdd 0]} {
        $vari access "Public"
    }
    if {![$this hasAdd 1]} {
        return
    }

    # Generate
    #
    set type [$this generateType $cl]
    set param [DPArgument new $type]
    set arg "new[$this typename]"
    $param name $arg
    set addproc [DPProcedure new]

    set type [DPType new]
    $type name [[[[$this assocattr] qualifier] ooplType] getType3GL]
    set keyparam [DPArgument new $type]
    $keyparam name  [$this varqual]
    $addproc addArg $keyparam
    $addproc addArg $param
    set addcode [DPTextSection new]
    set addtypes [DPTextSection new]
    set vartemp "old[$this typename]"

    $addproc gencode $addcode
    $addproc gentypes $addtypes
    $addproc hasUserSection 0
    $addproc access [$this propWrite]
    $addproc name "set[cap [$this varname]]"

    if {[[$this assocattr] opposite] != ""} {
        $addtypes append "var\n"
        $addtypes indent +
        $addtypes append "${vartemp}: [$this typename];\n"
        $addtypes indent -
    }

    $addcode append "if (${arg} <> NIL) then\nbegin\n"
    $addcode indent +

    if {[[$this assocattr] opposite] != ""} {
        $addcode append "${vartemp} := [$vari name].Item([$keyparam name]);\n"
        $addcode append "if (${vartemp} <> NIL) then\nbegin\n"
        $addcode indent +
        if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {
            $addcode append "[$this castType $vartemp].[$this opvarset].Remove(SELF);\n"
        } else {
            $addcode append "[$this castType $vartemp].[$this opvarref] := NIL;\n"
        }
        $addcode append "[$vari name].RemoveUsingKey([$keyparam name]);\n"
        $addcode indent -
        $addcode append "end;\n"

        if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {
            $addcode append "[$this castType $arg].[$this opvarset].Add(SELF);\n"
        } else {
            $addcode append "[$this castType $arg].[$this opvarref] := SELF;\n"
        }
    }

    $addcode append "[$vari name].Add([$keyparam name], ${arg});\n"
    $addcode indent -
    $addcode append "end;\n"

    $cl addAssocgenmethod $addproc
}

method DPGOneQual::generateGet {this vari cl} {

    # Check if Get method should be generated
    #
    if {![$this hasGet 0]} {
        $vari access "Public"
    }
    if {![$this hasGet 1]} {
        return
    }

    # Generate
    #
    set type [$this generateType $cl]
    set getproc [DPFunction new $type]
    set getcode [DPTextSection new]
    $getproc gencode $getcode
    $getproc hasUserSection 0
    $getproc access [$this propRead]
    $getproc name "get[cap [$this varname]]"
    $getcode append "[$getproc name] := [$this vardict].Item([$this varqual]);\n"

    set type [DPType new]
    $type name [[[[$this assocattr] qualifier] ooplType] getType3GL]
    set param [DPArgument new $type]
    $param name [$this varqual]
    $getproc addArg $param
    $cl addAssocgenmethod $getproc
}

method DPGOneQual::generateRemove {this vari cl} {
    if {![$this hasRemove 0]} {
        $vari access "Public"
    }
    if {![$this hasRemove 1]} {
        return
    }

    set removeproc [DPProcedure new]
    set type [DPType new]
    $type name [[[[$this assocattr] qualifier] ooplType] getType3GL]
    set param [DPArgument new $type]
    $param name [$this varqual]
    $removeproc addArg $param
    set removecode [DPTextSection new]
    set removetypes [DPTextSection new]
    $removeproc gencode $removecode
    $removeproc gentypes $removetypes
    $removeproc hasUserSection 0
    $removeproc name "remove[cap [$this varname]]"
    set vartemp "old[$this typename]"

    if {[$this propWrite] == "None"} {
        $removeproc access "Private"
        m4_warning $W_CHANGEDREM [[$this assocattr] getName] [[[$this assocattr] ooplClass] getName]
    } else {
        $removeproc access [$this propWrite]
    }

    if {[[$this assocattr] opposite] != ""} {
        $removetypes append "var\n"
        $removetypes indent +
        $removetypes append "${vartemp}: [$this typename];\n"
        $removetypes indent -
        $removecode append "${vartemp} := [$vari name].Item([$this varqual]);\n"
        $removecode append "if (${vartemp} <> NIL) then\nbegin\n"
        $removecode indent +

        if {[[[$this assocattr] opposite] isMandatory] && [[[$this assocattr] opposite] getMultiplicity] != "one"} {
           $removecode append "if (${vartemp}.[$this opvarset].Count > 1) then\nbegin\n"
           $removecode indent +
        }
        $removecode append "[$vari name].RemoveUsingKey([$this varqual]);\n"
        if {[[[$this assocattr] opposite] getMultiplicity] != "one"} {
            $removecode append "${vartemp}.[$this opvarset].Remove(SELF);\n"
        } else {
            $removecode append "${vartemp}.[$this opvarref] := NIL;\n"
        }
        if {[[[$this assocattr] opposite] isMandatory] && [[[$this assocattr] opposite] getMultiplicity] != "one"} {
           $removecode indent -
           $removecode append "end;\n"
        }

       $removecode indent -
       $removecode append "end;\n"
    } else {
        $removecode append "[$vari name].RemoveUsingKey([$this varqual])\n"
    }

    $cl addAssocgenmethod $removeproc
}

method DPGOneQual::generateDtor {this vari cl} {

    # Check if Destructor should be generated
    #
    if {![$this hasDtor 1]} {
        [[$cl destructr] gencode] append "[$this vardict].Destroy;\n"
        return
    }

    # Generate
    #
    if {[[$this assocattr] opposite] != ""} {
        if {[[[$this assocattr] opposite] isMandatory] && [[[$this assocattr] opposite] getMultiplicity] == "one"} {
            set sysutilstype [DPType new]
            $sysutilstype includeName "SysUtils"
            $sysutilstype includeType "imp"
            $sysutilstype addAsInclude [[[[[$this assocattr] opposite] ooplType] ooplClass] target]

            [[$cl destructr] gencode] append "if ([$this vardict].Count <> 0) then\n"
            [[$cl destructr] gencode] indent +
            [[$cl destructr] gencode] append "raise EInvalidOp.Create('Illegal object destruction. Mandatory relation "
            [[$cl destructr] gencode] append "[$this vardict] not empty.');\n"
            [[$cl destructr] gencode] indent -
        } else {
            [[$cl destructr] gencode] append "while ([$this vardict].Count > 0) do\nbegin\n"
            [[$cl destructr] gencode] indent +
            [[$cl destructr] gencode] append "remove[cap [$this varname]]([$this vardict].FirstKey)\n"
            [[$cl destructr] gencode] indent -
            [[$cl destructr] gencode] append "end;\n"
        }
    }
    [[$cl destructr] gencode] append "[$this vardict].Destroy;\n"
}

# Do not delete this line -- regeneration end marker



#---------------------------------------------------------------------------
#      File:           @(#)dpgassocat.tcl    /main/titanic/9


Class DPGAssocAttr : {DPGGenAssocAttr} {
    constructor
    method destructor
    method check
    method checkLocal
    method setGenerator
    method generate
}

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

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

method DPGAssocAttr::check {this} {
    set errornr [$this checkLocal]

    $this setGenerator
    [$this generator] check

    return $errornr
}

method DPGAssocAttr::checkLocal {this} {
    set errornr 0

    return $errornr
}

method DPGAssocAttr::setGenerator {this} {
   if {[$this generator] == ""} {
        if {[$this getMultiplicity] == "one"} {
            $this generator [DPGAssocOne new $this]
        } else {
            $this generator [DPGAssocMany new $this]
        }
    }
}

method DPGAssocAttr::generate {this class} {
    if {[$this hasGUIComponent]} {
        return
    }
    if {[$this checkLocal] > 0} {
        return
    }
    $this setGenerator
    [$this generator] generate $class
}

# Do not delete this line -- regeneration end marker

if [isCommand CMAssocAttr] {
    Class  DPGAssocAttrD : {DPGAssocAttr CMAssocAttr} {
    }
} else {
    Class DPGAssocAttrD : {DPGAssocAttr OPAssocAttr} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPAssocAttr) DPGAssocAttrD

selfPromoter OPAssocAttr {this} {
    DPGAssocAttrD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)dpglinkatt.tcl    /main/titanic/9


Class DPGLinkAttr : {DPGGenAssocAttr} {
    constructor
    method destructor
    method check
    method checkLocal
    method setGenerator
    method generate
}

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

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

method DPGLinkAttr::check {this} {
    set errornr [$this checkLocal]

    $this setGenerator
    [$this generator] check

    return $errornr
}

method DPGLinkAttr::checkLocal {this} {
    set errornr 0

    if {[[$this ooplType] isA OPBaseType]} {
        m4_warning $W_ASSOCTYPEERR [$this getName] [[$this ooplType] getName]
        incr errornr 1
    }

    return $errornr
}

method DPGLinkAttr::setGenerator {this} {
    if {[$this generator] == ""} {
        if {[$this getMultiplicity] == "one"} {
            $this generator [DPGAssocOne new $this]
        } else {
            $this generator [DPGAssocMany new $this]
        }
    }
}

method DPGLinkAttr::generate {this class} {
    if {[$this checkLocal] > 0} {
        return
    }

    if {[$this hasGUIComponent]} {
        return
    }

    $this setGenerator
    [$this generator] generate $class
}

# Do not delete this line -- regeneration end marker

if [isCommand CMLinkAttr] {
    Class  DPGLinkAttrD : {DPGLinkAttr CMLinkAttr} {
    }
} else {
    Class DPGLinkAttrD : {DPGLinkAttr OPLinkAttr} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPLinkAttr) DPGLinkAttrD

selfPromoter OPLinkAttr {this} {
    DPGLinkAttrD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)dpgqualatt.tcl    /main/titanic/9


Class DPGQualAttr : {DPGGenAssocAttr} {
    constructor
    method destructor
    method check
    method checkLocal
    method setGenerator
    method generate
}

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

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

method DPGQualAttr::check {this} {
    set errornr [$this checkLocal]

    $this setGenerator
    [$this generator] check

    return $errornr
}

method DPGQualAttr::checkLocal {this} {
    set errornr 0
    if {![[[$this qualifier] ooplType] isA OPBaseType]} {
        m4_error $E_QUALTYPEWRONG [[$this qualifier] getName] [$this getName]
        incr errornr 1
    }
    return $errornr
}

method DPGQualAttr::setGenerator {this} {
    if {[$this generator] == ""} {
        if {[$this getMultiplicity] == "one"} {
            $this generator [DPGOneQual new $this]
        } else {
            $this generator [DPGManyQual new $this]
        }
    }
}

method DPGQualAttr::generate {this class} {
    if {[$this checkLocal] > 0} {
        return
    }
    if {[$this hasGUIComponent]} {
        return
    }

    $this setGenerator
    [$this generator] generate $class
}

# Do not delete this line -- regeneration end marker

if [isCommand CMQualAttr] {
    Class  DPGQualAttrD : {DPGQualAttr CMQualAttr} {
    }
} else {
    Class DPGQualAttrD : {DPGQualAttr OPQualAttr} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPQualAttr) DPGQualAttrD

selfPromoter OPQualAttr {this} {
    DPGQualAttrD promote $this
}


#---------------------------------------------------------------------------
#      File:           @(#)dpgreverse.tcl    /main/titanic/8


Class DPGReverseLinkAttr : {DPGGenAssocAttr} {
    constructor
    method destructor
    method check
    method checkLocal
    method setGenerator
    method generate
}

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

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

method DPGReverseLinkAttr::check {this} {
    set errornr [$this checkLocal]

    $this setGenerator
    [$this generator] check

    return $errornr
}

method DPGReverseLinkAttr::checkLocal {this} {
    set errornr 0

    if {[[$this ooplType] isA OPBaseType]} {
        m4_warning $W_ASSOCTYPEERR [$this getName] [[$this ooplType] getName]
        incr errornr 1
    }

    return $errornr
}

method DPGReverseLinkAttr::setGenerator {this} {
    if {[$this generator] == ""} {
        if {[$this getMultiplicity] == "one"} {
            $this generator [DPGAssocOne new $this]
        } else {
            $this generator [DPGAssocMany new $this]
        }
    }
}

method DPGReverseLinkAttr::generate {this class} {
    if {[$this hasGUIComponent]} {
        return
    }

    $this setGenerator
    [$this generator] generate $class
}

# Do not delete this line -- regeneration end marker

if [isCommand CMReverseLinkAttr] {
    Class  DPGReverseLinkAttrD : {DPGReverseLinkAttr CMReverseLinkAttr} {
    }
} else {
    Class DPGReverseLinkAttrD : {DPGReverseLinkAttr OPReverseLinkAttr} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPReverseLinkAttr) DPGReverseLinkAttrD

selfPromoter OPReverseLinkAttr {this} {
    DPGReverseLinkAttrD promote $this
}


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


Class DPGQualAssocAttr : {DPGQualAttr} {
    constructor
    method destructor
}

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

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

# Do not delete this line -- regeneration end marker

if [isCommand CMQualAssocAttr] {
    Class  DPGQualAssocAttrD : {DPGQualAssocAttr CMQualAssocAttr} {
    }
} else {
    Class DPGQualAssocAttrD : {DPGQualAssocAttr OPQualAssocAttr} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPQualAssocAttr) DPGQualAssocAttrD

selfPromoter OPQualAssocAttr {this} {
    DPGQualAssocAttrD promote $this
}


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


Class DPGQualLinkAttr : {DPGQualAttr} {
    constructor
    method destructor
}

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

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

# Do not delete this line -- regeneration end marker

if [isCommand CMQualLinkAttr] {
    Class  DPGQualLinkAttrD : {DPGQualLinkAttr CMQualLinkAttr} {
    }
} else {
    Class DPGQualLinkAttrD : {DPGQualLinkAttr OPQualLinkAttr} {
    }
}

global mostDerivedOOPL ; set mostDerivedOOPL(OPQualLinkAttr) DPGQualLinkAttrD

selfPromoter OPQualLinkAttr {this} {
    DPGQualLinkAttrD promote $this
}