PC World 1997 November/PCWorld_1997-11_cd.bin/software/programy/komix/DATA.Z/prep_funcs.tcl

Text File | 1996-06-05 | 12KB | 388 lines

#---------------------------------------------------------------------------
#
# Copyright (c) 1993-1995 by Cadre Technologies 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 Cadre Technologies Inc.
#
#---------------------------------------------------------------------------
#
#       File            : @(#)prep_funcs.tcl    2.1
#       Author          : edri
#       Original date   : 11-10-94
#       Description     : Prepare functions for "check"
#
#---------------------------------------------------------------------------
#

proc oopl_model::prepare {model forwhat} {
    add_predefined_methods $model

    foreach class [getSelectedOoplClasses $model] {
        if {[$class isSynthetic] != "1"} {
        prepare $class $model $forwhat
        }
    }
    foreach subject [$model subjectSet] {
        prepare $subject $model $forwhat
    }

    foreach class [getSelectedOoplClasses $model] {
        #
    # add these attributes for more efficient operation of some of the
        # checks; these are only needed if there are any received_events
        # can only be done after all classes have been prepared, due to
        # extra operations/super classes added via addOperation or
        # add_super_class
        #
    if {[$class receivedEventSet] != {}} {
        $class addRunTimeProperty methods [find_methods $class 0]
        $class addRunTimeProperty flat_methods [find_methods $class 1]
    }
    }
}

proc class::prepare {class model forwhat} {
    foreach feature [$class featureSet] {
        if {[$feature isSynthetic] != "1"} {
        prepare $feature $class $model $forwhat
        }
    }
}

proc link_class::prepare {class model forwhat} {
    class::prepare $class $model $forwhat
}

proc class_enum::prepare {class model forwhat} {
}

proc class_typedef::prepare {class model forwhat} {
}

proc class_generic_typedef::prepare {class model forwhat} {
}

proc data_attrib::prepare {attrib class model forwhat} {
    set mdf [$attrib getPropertyValue modifier]
    if {$mdf != "" && $mdf != "Default"} {
        # when a modifier is specified
        # do not generate access funcs
        return
    }

    set name [cap [$attrib getName]]
    set type [[$attrib ooplType] getName]

    set op [$class addOperation get$name $type]
    copy_access_mode $attrib $op 1 r

    set op [$class addOperation set$name ""]
    $op addParameter new$name $type

    copy_access_mode $attrib $op 1 w
}

# Common prepare dispatch function for associations, works also for
# database associations.
# Only prepare for method-generating parts
#
proc prepare_for_assoc {attrib class model forwhat} {
    set prefix "[$attrib get_obj_type]::[$attrib getMultiplicity]"
    ${prefix}_get_prepare $attrib $class $model $forwhat
    ${prefix}_set_prepare $attrib $class $model $forwhat
    ${prefix}_remove_prepare $attrib $class $model $forwhat
}

# Common generate dispatch function for links
#
proc prepare_for_link {attrib class model forwhat} {
    set prefix "[$attrib get_obj_type]::[$attrib getMultiplicity]"
    ${prefix}_get_prepare $attrib $class $model $forwhat
}

#
# assoc_attrib prepare functions
#
proc assoc_attrib::prepare {attrib class model forwhat} {
    prepare_for_assoc $attrib $class $model $forwhat
}

proc assoc_attrib::one_get_prepare {attrib class model forwhat} {
    set type [[$attrib ooplType] getName]
    set name [cap [$attrib getName]]

    set op [$class addOperation get$name $type]
    copy_access_mode $attrib $op 0 r
}

proc assoc_attrib::one_set_prepare {attrib class model forwhat} {
    set type [[$attrib ooplType] getName]
    set name [cap [$attrib getName]]

    set op [$class addOperation set$name ""]
    $op addParameter new$name $type

    copy_access_mode $attrib $op 0 w
}

proc assoc_attrib::one_remove_prepare {attrib class model forwhat} {
    set name [cap [$attrib getName]]

    set op [$class addOperation remove$name ""]
    copy_access_mode $attrib $op 0 w
}

proc assoc_attrib::many_get_prepare {attrib class model forwhat} {
    set ordered [$attrib isOrdered]
    set settype [set_type_name [$attrib ooplType] $ordered]
    set setname [cap [set_name [$attrib getName] $ordered]]

    catch {$model addClass $settype}
    set op [$class addOperation get$setname $settype]
    copy_access_mode $attrib $op 0 r
}

proc assoc_attrib::many_set_prepare {attrib class model forwhat} {
    set type [[$attrib ooplType] getName]
    set name [cap [$attrib getName]]

    set op [$class addOperation add$name ""]
    $op addParameter new$name $type

    copy_access_mode $attrib $op 0 w
}

proc assoc_attrib::many_remove_prepare {attrib class model forwhat} {
    if [$attrib isMandatory] {
    return
    }

    set type [[$attrib ooplType] getName]
    set name [cap [$attrib getName]]

    set op [$class addOperation remove$name ""]
    $op addParameter old$name $type

    copy_access_mode $attrib $op 0 w
}

#
# qual_assoc_attrib prepare functions
#
proc qual_assoc_attrib::prepare {attrib class model forwhat} {
    prepare_for_assoc $attrib $class $model $forwhat
}

proc qual_assoc_attrib::one_get_prepare {attrib class model forwhat} {
    set type [[$attrib ooplType] getName]
    set name [cap [$attrib getName]]
    set keyname [[$attrib qualifier] getName]
    set keytype [[[$attrib qualifier] ooplType] getName]

    set op [$class addOperation get$name $type]
    $op addParameter $keyname $keytype

    copy_access_mode $attrib $op 0 r
}

proc qual_assoc_attrib::one_set_prepare {attrib class model forwhat} {
    set type [[$attrib ooplType] getName]
    set name [cap [$attrib getName]]
    set keyname [[$attrib qualifier] getName]
    set keytype [[[$attrib qualifier] ooplType] getName]

    set op [$class addOperation set$name ""]
    $op addParameter $keyname $keytype
    $op addParameter new$name $type

    copy_access_mode $attrib $op 0 w
}

proc qual_assoc_attrib::one_remove_prepare {attrib class model forwhat} {
    set name [cap [$attrib getName]]
    set keyname [[$attrib qualifier] getName]
    set keytype [[[$attrib qualifier] ooplType] getName]

    set op [$class addOperation remove$name ""]
    $op addParameter $keyname $keytype

    copy_access_mode $attrib $op 0 w
}

proc qual_assoc_attrib::many_get_prepare {attrib class model forwhat} {
    set settype [set_type_name [$attrib ooplType] [$attrib isOrdered]]
    set setname [cap [$attrib getName]]
    set keyname [[$attrib qualifier] getName]
    set keytype [[[$attrib qualifier] ooplType] getName]

    catch {$model addClass $settype}

    set op [$class addOperation get$setname $settype]
    $op addParameter $keyname $keytype

    copy_access_mode $attrib $op 0 r
}

proc qual_assoc_attrib::many_set_prepare {attrib class model forwhat} {
    set type [[$attrib ooplType] getName]
    set name [cap [$attrib getName]]
    set keyname [[$attrib qualifier] getName]
    set keytype [[[$attrib qualifier] ooplType] getName]

    set op [$class addOperation add$name ""]
    $op addParameter $keyname $keytype
    $op addParameter new$name $type

    copy_access_mode $attrib $op 0 w
}

proc qual_assoc_attrib::many_remove_prepare {attrib class model forwhat} {
    set type [[$attrib ooplType] getName]
    set name [cap [$attrib getName]]
    set keyname [[$attrib qualifier] getName]
    set keytype [[[$attrib qualifier] ooplType] getName]

    set op [$class addOperation remove$name ""]
    $op addParameter $keyname $keytype
    $op addParameter old$name $type

    copy_access_mode $attrib $op 0 w
}

#
# link_attrib prepare functions
#
proc link_attrib::prepare {attrib class model forwhat} {
    prepare_for_link $attrib $class $model $forwhat
}

proc link_attrib::one_get_prepare {attrib class model forwhat} {
    set type [[$attrib ooplType] getName]
    set name [cap "${type}Of[cap [$attrib getName]]"]

    set op [$class addOperation get$name $type]
    copy_access_mode $attrib $op 0 r
}

proc link_attrib::many_get_prepare {attrib class model forwhat} {
    set ordered [$attrib isOrdered]
    set settype [set_type_name [$attrib ooplType] $ordered]
    set setname [cap [set_name \
            "[[$attrib ooplType] getName]Of[cap [$attrib getName]]" $ordered]]

    catch {$model addClass $settype}
    set op [$class addOperation get$setname $settype]
    copy_access_mode $attrib $op 0 r
}

#
# rv_link_attrib prepare functions
#
proc rv_link_attrib::prepare {attrib class model forwhat} {
    prepare_for_link $attrib $class $model $forwhat
}

proc rv_link_attrib::one_get_prepare {attrib class model forwhat} {
    set type [[$attrib ooplType] getName]
    set name [cap [$attrib getName]]

    set op [$class addOperation get$name $type]
    copy_access_mode $attrib $op 0 r
}

proc rv_link_attrib::many_get_prepare {attrib class model forwhat} {
    # does not occur
}

#
# qual_link_attrib prepare functions
#
proc qual_link_attrib::prepare {attrib class model forwhat} {
    prepare_for_link $attrib $class $model $forwhat
}

proc qual_link_attrib::one_get_prepare {attrib class model forwhat} {
    set type [[$attrib ooplType] getName]
    set name [cap [[$attrib ooplType] getName]Of[cap [$attrib getName]]]
    set keyname [[$attrib qualifier] getName]
    set keytype [[[$attrib qualifier] ooplType] getName]

    set op [$class addOperation get$name $type]
    $op addParameter $keyname $keytype

    copy_access_mode $attrib $op 0 r
}

proc qual_link_attrib::many_get_prepare {attrib class model forwhat} {
    set settype [set_type_name [$attrib ooplType] [$attrib isOrdered]]
    set setname [cap [[$attrib ooplType] getName]Of[cap [$attrib getName]]]
    set keyname [ [$attrib qualifier] getName]
    set keytype [[[$attrib qualifier] ooplType] getName]

    catch {$model addClass $settype}
    set op [$class addOperation get$setname $settype]
    $op addParameter $keyname $keytype

    copy_access_mode $attrib $op 0 r
}

#
# operation prepare functions
#
proc operation::prepare {oper class model forwhat} {

    foreach param [get_parameters $oper] {
        prepare $param $class $model $forwhat
    }
}

proc parameter::prepare {param class model forwhat} {
}

proc base_type::prepare {class model forwhat} {
}

proc class_type::prepare {class model forwhat} {
}

proc typedef_type::prepare {class model forwhat} {
}

proc enum_type::prepare {class model forwhat} {
}

proc generic_typedef_type::prepare {class model forwhat} {
}

proc constructor::prepare {ctor class model forwhat} {

    foreach param [$class creationParamSet] {
        prepare $param $class $model $forwhat
    }
}

proc ctor_param::prepare {param class model forwhat} {
}

proc subject::prepare {subject model forwhat} {
}

proc cad_subject::prepare {subject model forwhat} {
}

proc ccd_subject::prepare {subject model forwhat} {
}

proc cad_ccd_subject::prepare {subject model forwhat} {
}

proc system_subject::prepare {subject model forwhat} {
}