home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / javagentor.tcl < prev    next >
Text File  |  1997-12-01  |  11KB  |  421 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. #
  16. #       File            : javagentor.tcl
  17. #       Author          : 
  18. #       Original date   : November 1997
  19. #       Description     : Classes for code generation
  20. #
  21. #---------------------------------------------------------------------------
  22.  
  23. #---------------------------------------------------------------------------
  24. #      File:           @(#)javafileha.tcl    /main/titanic/1
  25. #---------------------------------------------------------------------------
  26.  
  27. # Start user added include file section
  28. # End user added include file section
  29.  
  30. require "filehandle.tcl"
  31.  
  32. Class JavaFileHandler : {FileHandler} {
  33.     constructor
  34.     method destructor
  35.     method getFileName
  36.     method getFileTypes
  37.     method getSpecialFiles
  38.     method setImpFrom
  39.     attribute javaType
  40. }
  41.  
  42. constructor JavaFileHandler {class this} {
  43.     set this [FileHandler::constructor $class $this]
  44.     # Start constructor user section
  45.  
  46.     $this javaType "java"
  47.  
  48.     # End constructor user section
  49.     return $this
  50. }
  51.  
  52. method JavaFileHandler::destructor {this} {
  53.     # Start destructor user section
  54.     # End destructor user section
  55.     $this FileHandler::destructor
  56. }
  57.  
  58. method JavaFileHandler::getFileName {this class fileType} {
  59.     set unitName [$class getPropertyValue "source_file"]
  60.  
  61.     if {$unitName == ""} {
  62.         set unitName [$class getName]
  63.     }
  64.  
  65.     return "$unitName.$fileType"
  66. }
  67.  
  68. method JavaFileHandler::getFileTypes {this} {
  69.     set list [List new]
  70.  
  71.     $list append [$this javaType]
  72.  
  73.     return $list
  74. }
  75.  
  76. method JavaFileHandler::getSpecialFiles {this} {
  77.     return [List new]
  78. }
  79.  
  80. method JavaFileHandler::setImpFrom {this fileName class} {
  81.     set unit [$class unit]
  82.  
  83.     if {$unit == ""} {
  84.         return [fstorage::set_imp_from $fileName [$class getName]]
  85.     }
  86.  
  87.     set names ""
  88.  
  89.     [$unit containerSet] foreach container {
  90.         lappend names [$container name]
  91.     }
  92.  
  93.     return [fstorage::set_imp_from $fileName $names]
  94. }
  95.  
  96. # Do not delete this line -- regeneration end marker
  97.  
  98. #---------------------------------------------------------------------------
  99. #      File:           @(#)javagenera.tcl    /main/titanic/2
  100. #---------------------------------------------------------------------------
  101.  
  102. # Start user added include file section
  103. # End user added include file section
  104.  
  105. require "generator.tcl"
  106.  
  107. Class JavaGenerator : {Generator} {
  108.     constructor
  109.     method destructor
  110.     method check
  111.     method generate
  112.     attribute fileHandler
  113. }
  114.  
  115. constructor JavaGenerator {class this} {
  116.     set this [Generator::constructor $class $this]
  117.     # Start constructor user section
  118.  
  119.     $this fileHandler [JavaFileHandler new]
  120.  
  121.     # End constructor user section
  122.     return $this
  123. }
  124.  
  125. method JavaGenerator::destructor {this} {
  126.     # Start destructor user section
  127.     # End destructor user section
  128.     $this Generator::destructor
  129. }
  130.  
  131. method JavaGenerator::check {this classList} {
  132.     $classList foreach class {
  133.         $class check
  134.     }
  135. }
  136.  
  137. method JavaGenerator::generate {this classList} {
  138.     set typeToClassDictionary [Dictionary new]
  139.     set javaModel [JavaModel new]
  140.     set regenerator [JavaRegenerator new]
  141.     set javaType [[$this fileHandler] javaType]
  142.  
  143.     $classList foreach class {
  144.         $class generate $javaModel
  145.         set fileDesc [[$this fileHandler] openFile $class $javaType]
  146.  
  147.         if {$fileDesc != ""} {
  148.         $regenerator regenerate $class $fileDesc
  149.  
  150.         [$this fileHandler] closeFile $fileDesc
  151.         }
  152.     }
  153.  
  154.     $javaModel generate $typeToClassDictionary
  155.  
  156.     return $typeToClassDictionary
  157. }
  158.  
  159. # Do not delete this line -- regeneration end marker
  160.  
  161. #---------------------------------------------------------------------------
  162. #      File:           @(#)javaregene.tcl    /main/titanic/5
  163. #---------------------------------------------------------------------------
  164.  
  165. # Start user added include file section
  166. # End user added include file section
  167.  
  168. require "regenerato.tcl"
  169.  
  170. Class JavaRegenerator : {Regenerator} {
  171.     constructor
  172.     method destructor
  173.     method addBodyToMethod
  174.     method findClass
  175.     method grabUserBody
  176.     method prepare
  177.     method regenerate
  178. }
  179.  
  180. constructor JavaRegenerator {class this} {
  181.     set this [Regenerator::constructor $class $this]
  182.     # Start constructor user section
  183.     # End constructor user section
  184.     return $this
  185. }
  186.  
  187. method JavaRegenerator::destructor {this} {
  188.     # Start destructor user section
  189.     # End destructor user section
  190.     $this Regenerator::destructor
  191. }
  192.  
  193. method JavaRegenerator::addBodyToMethod {this class name params body} {
  194.     if {[$class getName] == "$name"} {
  195.         set methodList [[$class container] constructorSet]
  196.     } else {
  197.         set methodList [[$class container] methodSet]
  198.     }
  199.  
  200.     $methodList foreach javaMethod {
  201.         if {[$javaMethod name] == "$name"} {
  202.         set javaParams [[$javaMethod generateParameterList] contents]
  203.  
  204.         if {"$javaParams" == "$params"} {
  205.             $javaMethod userBody $body
  206.  
  207.             return "0"
  208.         }
  209.         }
  210.     }
  211.  
  212.     return "-1"
  213. }
  214.  
  215. method JavaRegenerator::findClass {this fileDesc} {
  216.     set classExpr {class[     ]+(.+)[     ]+extends[     ]+}
  217.  
  218.     while {![eof $fileDesc]} {
  219.         set line [gets $fileDesc]
  220.  
  221.         if [regexp $classExpr $line complete name] {
  222.         return $name
  223.         }
  224.     }
  225.  
  226.     return ""
  227. }
  228.  
  229. method JavaRegenerator::grabUserBody {this fileDesc name} {
  230.     set result [TextSection new]
  231.     set line [gets $fileDesc]
  232.  
  233.     while {![eof $fileDesc]} {
  234.         if {[string match *${JavaCookie::startUserSection} $line]} {
  235.         set result [TextSection new]
  236.         set line [gets $fileDesc]
  237.  
  238.         while {![eof $fileDesc] &&
  239.                ![string match *${JavaCookie::endUserSection} $line]} {
  240.             $result append "$line\n"
  241.             set line [gets $fileDesc]
  242.         }
  243.  
  244.         return $result
  245.         }
  246.  
  247.         if [string match "*//*${JavaCookie::endMarker}*" $line] {
  248.         return $result
  249.         }
  250.  
  251.         if [string match "    \}*" $line] {
  252.         m4_warning $W_NOMARKER $name
  253.         return $result
  254.         }
  255.  
  256.         $result append "$line\n"
  257.         set line [gets $fileDesc]
  258.     }
  259.  
  260.     return $result
  261. }
  262.  
  263. method JavaRegenerator::prepare {this fileDesc class} {
  264.     #
  265.     # Do a sanity check, and in the same pass load the user defined
  266.     # import statements.
  267.     #
  268.  
  269.     set importExpr {^[     ]*import[     ]*(.*)[     ]*;.*}
  270.     set checkForImports 0
  271.  
  272.     while {![eof $fileDesc]} {
  273.         set line [gets $fileDesc]
  274.  
  275.         if [string match *${JavaCookie::startObsoleteCodeSection} $line] {
  276.         seek $fileDesc 0
  277.  
  278.         return "1"
  279.         }
  280.  
  281.         if [string match *${JavaCookie::endObsoleteCodeSection} $line] {
  282.         seek $fileDesc 0
  283.  
  284.         return "1"
  285.         }
  286.  
  287.         if [string match *${JavaCookie::startUserImportSection} $line] {
  288.         if {[[$class unit] masterContainer] == [$class container]} {
  289.             set checkForImports 1
  290.         }
  291.         }
  292.  
  293.         if [string match *${JavaCookie::endUserImportSection} $line] {
  294.         set checkForImports 0
  295.         }
  296.  
  297.         if {$checkForImports && [regexp $importExpr $line all name]} {
  298.         [$class unit] addUserImport [JavaPackageName new $name]
  299.         }
  300.     }
  301.     
  302.     seek $fileDesc 0
  303.  
  304.     return "0"
  305. }
  306.  
  307. method JavaRegenerator::regenerate {this class fileDesc} {
  308.     if {[$class unit] == ""} {
  309.         m4_error $E_CLASSNOTFOUND [$class getName]
  310.         return
  311.     }
  312.  
  313.     if [$this prepare $fileDesc $class] {
  314.         m4_error $E_OBSOLETESECT [$class getName]
  315.         return
  316.     }
  317.  
  318.     set endRegeneration ${JavaCookie::regenerationEndSection}
  319.     set methodExpr {^[     ]*(public|private protected|private|protected)?[     ]*(static|abstract|final|native|synchronized)?[     ]*(static|abstract|final|native|synchronized)?([^=]+)[     ]+([^=]+)[     ]*(\(.*\))[ ]*(throws[     ]+.*)*([\{;])}
  320.     set staticExpr {^[     ]*static[     ]*\{}
  321.     set completeMatch ""
  322.     set access ""
  323.     set modifier1 ""
  324.     set modifier2 ""
  325.     set wtype ""
  326.     set method ""
  327.     set params ""
  328.     set throwsClause ""
  329.     set className [$this findClass $fileDesc]
  330.  
  331.     while {![eof $fileDesc] && [$class getName] != $className} {
  332.         set className [$this findClass $fileDesc]
  333.     }
  334.  
  335.     while {![eof $fileDesc]} {
  336.         set line [gets $fileDesc]
  337.  
  338.         if [string match *$endRegeneration $line] {
  339.         break
  340.         }
  341.  
  342.         if {[regexp $staticExpr $line completeMatch]} {
  343.         set body [$this grabUserBody $fileDesc static]
  344.  
  345.         if [$this addBodyToMethod $class static "" $body] {
  346.             if {[$body contents] != ""} {
  347.             set obsoleteBody(static) $body
  348.             set obsoleteLine(static) $line
  349.             set obsoleteName(static) static
  350.             }
  351.         }
  352.         } elseif {[regexp $methodExpr $line completeMatch access modifier1 modifier2 wtype method params throwsClause lineTerminator]} {
  353.         set body ""
  354.         if {[string match "*;" $lineTerminator] &&
  355.             ([string match "abstract" $modifier1] ||
  356.              [string match "abstract" $modifier2] ||
  357.              [string match "native" $modifier1] ||
  358.              [string match "native" $modifier2])} {
  359.             # DO NOTHING -- abstract/native methods have no body
  360.         } else {
  361.             set body [$this grabUserBody $fileDesc $method]
  362.  
  363.             if [$this addBodyToMethod $class $method $params $body] {
  364.             if {[$body contents] != ""} {
  365.                 set obsoleteBody($method$params) $body
  366.                 set obsoleteLine($method$params) $line
  367.                 set obsoleteName($method$params) $method
  368.             }
  369.             }
  370.         }
  371.         }
  372.     }
  373.  
  374.     if [info exists obsoleteBody] {
  375.         foreach signature [array names obsoleteBody] {
  376.         set name $obsoleteName($signature)
  377.  
  378.         if {"$className" == "$name"} {
  379.             set methodList [[$class container] constructorSet]
  380.         } else {
  381.             set methodList [[$class container] methodSet]
  382.         }
  383.  
  384.         $methodList foreach javaMethod {
  385.             if {[$javaMethod name] == "$name" &&
  386.             [$javaMethod userBody] == ""} {
  387.             set javaParams [$javaMethod generateParameterList]
  388.  
  389.             m4_warning $W_OLDCODE $className $signature $name[$javaParams contents]
  390.  
  391.             $javaMethod userBody $obsoleteBody($signature)
  392.  
  393.             unset obsoleteBody($signature)
  394.             unset obsoleteLine($signature)
  395.             unset obsoleteName($signature)
  396.  
  397.             break
  398.             }
  399.         }
  400.  
  401.         if [info exists obsoleteBody($signature)] {
  402.             m4_warning $W_OBSOLETECODE $className $signature
  403.  
  404.             set sect [[$class container] obsoleteCode]
  405.  
  406.             if {$sect == ""} {
  407.             set sect [TextSection new]
  408.             [$class container] obsoleteCode $sect
  409.             }
  410.  
  411.             $sect append "[string trimleft $obsoleteLine($signature)]\n"
  412.             $sect appendSect $obsoleteBody($signature)
  413.             $sect append "\}\n\n"
  414.         }
  415.         }
  416.     }
  417. }
  418.  
  419. # Do not delete this line -- regeneration end marker
  420.  
  421.