home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / rt_forte.tcl < prev    next >
Text File  |  1997-08-15  |  7KB  |  219 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. # Copyright (c) 1997 by Cayenne Software Inc.
  4. #
  5. # This software is furnished under a license and may be used only in
  6. # accordance with the terms of such license and with the inclusion of
  7. # the above copyright notice. This software or any other copies thereof
  8. # may not be provided or otherwise made available to any other person.
  9. # No title to and ownership of the software is hereby transferred.
  10. #
  11. # The information in this software is subject to change without notice
  12. # and should not be construed as a commitment by Cayenne Software Inc.
  13. #
  14. #---------------------------------------------------------------------------
  15. #   @(#)forte.tcl    /main/titanic/2
  16. #---------------------------------------------------------------------------
  17. #
  18. # This file contains heuristic methods to retrieve section names for
  19. # attributes and methods as part of Forte roundtrip engineering.
  20. #
  21. # Heuristic rules used:
  22. #
  23. # - Attribute section retrieval:
  24. #   * has the attribute a section assigned yet?
  25. #     if so: use that section
  26. #   * is the attribute initialized?
  27. #     if so: this is a user-defined attribute
  28. #   * is the attribute derived (i.e. modifier '/')?
  29. #     if so: this is a user-defined attribute
  30. #   * is the attribute a constant (i.e. property 'const' == "1")?
  31. #     if so: this is a user-defined attribute
  32. #   * is the attribute's type not a class type, or has it no type at all?
  33. #     if so: this is a user-defined attribute
  34. #   * is the attribute's type a class type, and is none of the above true?
  35. #     if so: assume that this is an association attribute
  36. #   * if no rule applies, assume that this is a user-defined attribute
  37. #
  38. # - Method section retrieval:
  39. #   * has the method a section assigned yet?
  40. #     if so: use that section
  41. #   * has the method an 'oper_type' other than "Method"?
  42. #     if so: this method is a user-defined method
  43. #   * does the name of the method start with "get", "set", "remove", "add"
  44. #     or "append"?
  45. #     if so: this is a candidate accessor method
  46. #   * is this method a candidate 'get' accessor, and does it have more than
  47. #     one parameter or does it have no return type?
  48. #     if so: this method is a user-defined method
  49. #   * is this method a candidate 'set' accessor, and does it have more than
  50. #     two parameters or does it have a return type?
  51. #     if so: this method is a user-defined method
  52. #   * is this method a candidate accessor and is it not possible to map one
  53. #     of the attribute names in this class to its name?
  54. #     if so: this method is a user-defined method
  55. #   * is this method a candidate accessor for one of the user-defined
  56. #     attributes of this class?
  57. #     if so: this method is an attribute accessor method
  58. #   * is this method a candidate accessor for one of the association
  59. #     attributes of this class?
  60. #     if so: this method is an association accessor method
  61. #   * if no rule applies, assume that this is a user-defined method
  62. #
  63.  
  64. puts stderr "Roundtrip engineering section retrieval activated."
  65.  
  66.  
  67. Class ForteRTDiagram : {RTDiagram} {
  68.     method save
  69. }
  70.  
  71. method ForteRTDiagram::save {this {filename ""}} {
  72.     [$this rtCompSet] foreach comp {
  73.     if {[$comp isA RTAttrib] || [$comp isA RTMethod]} {
  74.         if {[$comp section] == ""} {
  75.         $comp ftRetrieveSect
  76.         if {[info exists debug]} {
  77.             puts stderr "$comp: '[$comp getLabel name_type]' -> [$comp section]"
  78.         }
  79.         }
  80.     }
  81.     }
  82.  
  83.     $this RTDiagram::save $filename
  84. }
  85.  
  86. selfPromoter RTDiagram {this} {
  87.     ForteRTDiagram promote $this
  88. }
  89.  
  90.  
  91.  
  92. Class ForteRTAttrib : {RTAttrib} {
  93.     method ftRetrieveSect
  94.     method ftIsDict
  95. }
  96.  
  97. method ForteRTAttrib::ftRetrieveSect {this} {
  98.     set user    "user-defined-attribute"
  99.     set assoc    "association-attribute-storage"
  100.     $this update
  101.  
  102.     set type [$this type]
  103.     # strip qualifier
  104.     regsub {.*\.} $type {} type
  105.     set const [$this findProp const de]
  106.     if {$const != ""} {
  107.     set const [$const value]
  108.     }
  109.     if {[$this initValue] != "" || [$this mods] != "" || $type == "" || $const == "1"} {
  110.     $this section $user
  111.     return
  112.     }
  113.  
  114.     set langTypeTable [LangTypeTable::createTable]
  115.     if {[$langTypeTable getType $type] == ""} {
  116.     if {[string tolower $type] == "hashtable"} {
  117.         if {[$this ftIsDict]} {
  118.         $this section $assoc
  119.         } else {
  120.         $this section $user
  121.         }
  122.         return
  123.     }
  124.  
  125.     $this section $assoc
  126.     return
  127.     }
  128.  
  129.     $this section $user
  130. }
  131.  
  132. method ForteRTAttrib::ftIsDict {this} {
  133.     set aname [$this name]
  134.     regsub -nocase {set$} $aname {} aname
  135.  
  136.     [[$this rtClass] rtMethodSet] foreach meth {
  137.     if {[$meth name] == ""} {
  138.         $meth ftRetrieveSect
  139.     }
  140.     set mname [string tolower [$meth name]]
  141.  
  142.     if {"get${aname}set" == $mname || "get$aname" == $mname} {
  143.         if {[[$meth rtParamSet] length] == 1 && [$meth type] != ""} {
  144.         return 1
  145.         }
  146.     } elseif {"set$aname" == $mname || "add$aname" == $mname || "append$aname" == $mname || "remove$aname" == $mname} {
  147.         if {[[$meth rtParamSet] length] == 2 && [$meth type] == ""} {
  148.         return 1
  149.         }
  150.     }
  151.     }
  152.  
  153.     return 0
  154. }
  155.  
  156. selfPromoter RTAttrib {this} {
  157.     ForteRTAttrib promote $this
  158. }
  159.  
  160.  
  161.  
  162. Class ForteRTMethod : {RTMethod} {
  163.     method ftRetrieveSect
  164. }
  165.  
  166. method ForteRTMethod::ftRetrieveSect {this} {
  167.     set user    "user-defined-method"
  168.     set attrib    "attribute-accessor-method"
  169.     set assoc    "association-accessor-method"
  170.  
  171.     if {[[$this findProp oper_type pe] value] != "Method"} {
  172.     $this section $user
  173.     return
  174.     }
  175.  
  176.     $this update
  177.  
  178.     if {[regexp -nocase {^(set|add|append|remove|get)(.+)} [$this name] dummy accKind accName]} {
  179.  
  180.     if {[string tolower $accKind] == "get"} {
  181.         if {[[$this rtParamSet] length] > 1 || [$this type] == ""} {
  182.         $this section $user
  183.         return
  184.         }
  185.     } else {
  186.         if {[[$this rtParamSet] length] > 2 || [$this type] != ""} {
  187.         $this section $user
  188.         return
  189.         }
  190.     }
  191.  
  192.     set attrFound 0
  193.     [[$this rtClass] rtAttribSet] foreach attr {
  194.         if {[$attr section] == ""} {
  195.         $attr ftRetrieveSect
  196.         }
  197.         if {[regexp -nocase "^${accName}\$" [$attr name]] || [regexp -nocase "^${accName}set\$" [$attr name]]} {
  198.         set attrFound 1
  199.         break
  200.         }
  201.     }
  202.  
  203.     if {!$attrFound} {
  204.         $this section $user
  205.     } elseif {[$attr section] == "user-defined-attribute"} {
  206.         $this section $attrib
  207.     } else {
  208.         $this section $assoc
  209.     }
  210.     return
  211.     }
  212.  
  213.     $this section $user
  214. }
  215.  
  216. selfPromoter RTMethod {this} {
  217.     ForteRTMethod promote $this
  218. }
  219.