home *** CD-ROM | disk | FTP | other *** search
- #---------------------------------------------------------------------------
- #
- # 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} {
- }
-