home *** CD-ROM | disk | FTP | other *** search
- #---------------------------------------------------------------------------
- #
- # 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.
- #
- #---------------------------------------------------------------------------
- # @(#)forte.tcl /main/titanic/2
- #---------------------------------------------------------------------------
- #
- # This file contains heuristic methods to retrieve section names for
- # attributes and methods as part of Forte roundtrip engineering.
- #
- # Heuristic rules used:
- #
- # - Attribute section retrieval:
- # * has the attribute a section assigned yet?
- # if so: use that section
- # * is the attribute initialized?
- # if so: this is a user-defined attribute
- # * is the attribute derived (i.e. modifier '/')?
- # if so: this is a user-defined attribute
- # * is the attribute a constant (i.e. property 'const' == "1")?
- # if so: this is a user-defined attribute
- # * is the attribute's type not a class type, or has it no type at all?
- # if so: this is a user-defined attribute
- # * is the attribute's type a class type, and is none of the above true?
- # if so: assume that this is an association attribute
- # * if no rule applies, assume that this is a user-defined attribute
- #
- # - Method section retrieval:
- # * has the method a section assigned yet?
- # if so: use that section
- # * has the method an 'oper_type' other than "Method"?
- # if so: this method is a user-defined method
- # * does the name of the method start with "get", "set", "remove", "add"
- # or "append"?
- # if so: this is a candidate accessor method
- # * is this method a candidate 'get' accessor, and does it have more than
- # one parameter or does it have no return type?
- # if so: this method is a user-defined method
- # * is this method a candidate 'set' accessor, and does it have more than
- # two parameters or does it have a return type?
- # if so: this method is a user-defined method
- # * is this method a candidate accessor and is it not possible to map one
- # of the attribute names in this class to its name?
- # if so: this method is a user-defined method
- # * is this method a candidate accessor for one of the user-defined
- # attributes of this class?
- # if so: this method is an attribute accessor method
- # * is this method a candidate accessor for one of the association
- # attributes of this class?
- # if so: this method is an association accessor method
- # * if no rule applies, assume that this is a user-defined method
- #
-
- puts stderr "Roundtrip engineering section retrieval activated."
-
-
- Class ForteRTDiagram : {RTDiagram} {
- method save
- }
-
- method ForteRTDiagram::save {this {filename ""}} {
- [$this rtCompSet] foreach comp {
- if {[$comp isA RTAttrib] || [$comp isA RTMethod]} {
- if {[$comp section] == ""} {
- $comp ftRetrieveSect
- if {[info exists debug]} {
- puts stderr "$comp: '[$comp getLabel name_type]' -> [$comp section]"
- }
- }
- }
- }
-
- $this RTDiagram::save $filename
- }
-
- selfPromoter RTDiagram {this} {
- ForteRTDiagram promote $this
- }
-
-
-
- Class ForteRTAttrib : {RTAttrib} {
- method ftRetrieveSect
- method ftIsDict
- }
-
- method ForteRTAttrib::ftRetrieveSect {this} {
- set user "user-defined-attribute"
- set assoc "association-attribute-storage"
- $this update
-
- set type [$this type]
- # strip qualifier
- regsub {.*\.} $type {} type
- set const [$this findProp const de]
- if {$const != ""} {
- set const [$const value]
- }
- if {[$this initValue] != "" || [$this mods] != "" || $type == "" || $const == "1"} {
- $this section $user
- return
- }
-
- set langTypeTable [LangTypeTable::createTable]
- if {[$langTypeTable getType $type] == ""} {
- if {[string tolower $type] == "hashtable"} {
- if {[$this ftIsDict]} {
- $this section $assoc
- } else {
- $this section $user
- }
- return
- }
-
- $this section $assoc
- return
- }
-
- $this section $user
- }
-
- method ForteRTAttrib::ftIsDict {this} {
- set aname [$this name]
- regsub -nocase {set$} $aname {} aname
-
- [[$this rtClass] rtMethodSet] foreach meth {
- if {[$meth name] == ""} {
- $meth ftRetrieveSect
- }
- set mname [string tolower [$meth name]]
-
- if {"get${aname}set" == $mname || "get$aname" == $mname} {
- if {[[$meth rtParamSet] length] == 1 && [$meth type] != ""} {
- return 1
- }
- } elseif {"set$aname" == $mname || "add$aname" == $mname || "append$aname" == $mname || "remove$aname" == $mname} {
- if {[[$meth rtParamSet] length] == 2 && [$meth type] == ""} {
- return 1
- }
- }
- }
-
- return 0
- }
-
- selfPromoter RTAttrib {this} {
- ForteRTAttrib promote $this
- }
-
-
-
- Class ForteRTMethod : {RTMethod} {
- method ftRetrieveSect
- }
-
- method ForteRTMethod::ftRetrieveSect {this} {
- set user "user-defined-method"
- set attrib "attribute-accessor-method"
- set assoc "association-accessor-method"
-
- if {[[$this findProp oper_type pe] value] != "Method"} {
- $this section $user
- return
- }
-
- $this update
-
- if {[regexp -nocase {^(set|add|append|remove|get)(.+)} [$this name] dummy accKind accName]} {
-
- if {[string tolower $accKind] == "get"} {
- if {[[$this rtParamSet] length] > 1 || [$this type] == ""} {
- $this section $user
- return
- }
- } else {
- if {[[$this rtParamSet] length] > 2 || [$this type] != ""} {
- $this section $user
- return
- }
- }
-
- set attrFound 0
- [[$this rtClass] rtAttribSet] foreach attr {
- if {[$attr section] == ""} {
- $attr ftRetrieveSect
- }
- if {[regexp -nocase "^${accName}\$" [$attr name]] || [regexp -nocase "^${accName}set\$" [$attr name]]} {
- set attrFound 1
- break
- }
- }
-
- if {!$attrFound} {
- $this section $user
- } elseif {[$attr section] == "user-defined-attribute"} {
- $this section $attrib
- } else {
- $this section $assoc
- }
- return
- }
-
- $this section $user
- }
-
- selfPromoter RTMethod {this} {
- ForteRTMethod promote $this
- }
-