home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / fortegen.tcl < prev    next >
Encoding:
Text File  |  1997-12-01  |  18.9 KB  |  723 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            : fortegen.tcl
  17. #       Author          : 
  18. #       Original date   : November 1997
  19. #       Description     : Classes for code generation
  20. #
  21. #---------------------------------------------------------------------------
  22.  
  23. #---------------------------------------------------------------------------
  24. #      File:           @(#)ftconstant.tcl    /main/titanic/4
  25. #---------------------------------------------------------------------------
  26.  
  27. # Start user added include file section
  28. # End user added include file section
  29.  
  30.  
  31. Class FTConstants : {Object} {
  32.     constructor
  33.     method destructor
  34. }
  35.  
  36. global FTConstants::startCtor
  37. set FTConstants::startCtor "Start constructor user section"
  38.  
  39. global FTConstants::endCtor
  40. set FTConstants::endCtor "End constructor user section"
  41.  
  42. global FTConstants::obsoleteCode
  43. set FTConstants::obsoleteCode "OBSOLETE_CODE"
  44.  
  45. global FTConstants::oldCode
  46. set FTConstants::oldCode "OLDCODE"
  47.  
  48. global FTConstants::attribute
  49. set FTConstants::attribute "User-defined attributes"
  50.  
  51. global FTConstants::constant
  52. set FTConstants::constant ${FTConstants::attribute}
  53.  
  54. global FTConstants::virtualAttribute
  55. set FTConstants::virtualAttribute ${FTConstants::attribute}
  56.  
  57. global FTConstants::assocAttribute
  58. set FTConstants::assocAttribute "Association attributes"
  59.  
  60. global FTConstants::method
  61. set FTConstants::method "User-defined methods"
  62.  
  63. global FTConstants::event
  64. set FTConstants::event ${FTConstants::method}
  65.  
  66. global FTConstants::eventHandler
  67. set FTConstants::eventHandler ${FTConstants::method}
  68.  
  69. global FTConstants::attribAccessMethod
  70. set FTConstants::attribAccessMethod "Attribute accessor methods"
  71.  
  72. global FTConstants::assocAccessMethod
  73. set FTConstants::assocAccessMethod "Association accessor methods"
  74.  
  75.  
  76. constructor FTConstants {class this} {
  77.     set this [Object::constructor $class $this $name]
  78.     # Start constructor user section
  79.     # End constructor user section
  80.     return $this
  81. }
  82.  
  83. method FTConstants::destructor {this} {
  84.     # Start destructor user section
  85.     # End destructor user section
  86. }
  87.  
  88. # Do not delete this line -- regeneration end marker
  89.  
  90. #---------------------------------------------------------------------------
  91. #      File:           @(#)ftfilehand.tcl    /main/titanic/2
  92. #---------------------------------------------------------------------------
  93.  
  94. # Start user added include file section
  95. # End user added include file section
  96.  
  97. require "filehandle.tcl"
  98.  
  99. Class FTFileHandler : {FileHandler} {
  100.     constructor
  101.     method destructor
  102.     method getSpecialFiles
  103.     method getFileTypes
  104.     attribute fileType
  105.     attribute xtraFileType
  106. }
  107.  
  108. constructor FTFileHandler {class this} {
  109.     set this [FileHandler::constructor $class $this]
  110.     $this fileType "cex"
  111.     $this xtraFileType "hex"
  112.     # Start constructor user section
  113.     # End constructor user section
  114.     return $this
  115. }
  116.  
  117. method FTFileHandler::destructor {this} {
  118.     # Start destructor user section
  119.     # End destructor user section
  120.     $this FileHandler::destructor
  121. }
  122.  
  123. method FTFileHandler::getSpecialFiles {this} {
  124.     return [List new]
  125. }
  126.  
  127. method FTFileHandler::getFileTypes {this} {
  128.     set list [List new]
  129.     $list append [$this fileType]
  130.     $list append [$this xtraFileType]
  131.     return $list
  132. }
  133.  
  134. # Do not delete this line -- regeneration end marker
  135.  
  136. #---------------------------------------------------------------------------
  137. #      File:           @(#)ftgenerato.tcl    /main/titanic/3
  138. #---------------------------------------------------------------------------
  139.  
  140. # Start user added include file section
  141. # End user added include file section
  142.  
  143. require "generator.tcl"
  144.  
  145. Class FTGenerator : {Generator} {
  146.     constructor
  147.     method destructor
  148.     method generate
  149.     method check
  150.     attribute fileHandler
  151. }
  152.  
  153. constructor FTGenerator {class this} {
  154.     set this [Generator::constructor $class $this]
  155.     # Start constructor user section
  156.     $this fileHandler [FTFileHandler new]
  157.     # End constructor user section
  158.     return $this
  159. }
  160.  
  161. method FTGenerator::destructor {this} {
  162.     # Start destructor user section
  163.     # End destructor user section
  164.     $this Generator::destructor
  165. }
  166.  
  167. method FTGenerator::generate {this classList} {
  168.     set typeToClassDict [Dictionary new]
  169.     set tgtModel [FTModel new]
  170.     set regenerator [FTRegenerator new]
  171.     set fileType [[$this fileHandler] fileType]
  172.  
  173.     $classList foreach class {
  174.     $class generate $tgtModel
  175.  
  176.     set fileDesc [[$this fileHandler] openFile $class $fileType]
  177.     if {$fileDesc != ""} {
  178.         $regenerator regenerate $class $fileDesc $tgtModel
  179.         [$this fileHandler] closeFile $fileDesc
  180.     }
  181.     }
  182.  
  183.     $tgtModel generate $typeToClassDict
  184.     return $typeToClassDict
  185. }
  186.  
  187. method FTGenerator::check {this classList} {
  188.     set tgtModel [FTModel new]
  189.     $classList foreach class {
  190.     #
  191.     # we check a class by generating it with 'checkOnly' on
  192.     #
  193.     $class generate $tgtModel 1
  194.     }
  195. }
  196.  
  197. # Do not delete this line -- regeneration end marker
  198.  
  199. #---------------------------------------------------------------------------
  200. #      File:           @(#)ftregenera.tcl    /main/titanic/7
  201. #---------------------------------------------------------------------------
  202.  
  203. # Start user added include file section
  204. # End user added include file section
  205.  
  206. require "regenerato.tcl"
  207.  
  208. Class FTRegenerator : {Regenerator} {
  209.     constructor
  210.     method destructor
  211.     method regenerate
  212.     method checkFile
  213.     method processClass
  214.     method processClassDecl
  215.     method processClassUserBody
  216.     method processClassUserBodies
  217.     method processClassInit
  218.     method processCursor
  219.     method makeOldCode
  220.     method makeObsolete
  221.     method hasSameKind
  222.     attribute tgtClass
  223. }
  224.  
  225. constructor FTRegenerator {class this} {
  226.     set this [Regenerator::constructor $class $this]
  227.     # Start constructor user section
  228.     # End constructor user section
  229.     return $this
  230. }
  231.  
  232. method FTRegenerator::destructor {this} {
  233.     # Start destructor user section
  234.     # End destructor user section
  235.     $this Regenerator::destructor
  236. }
  237.  
  238. method FTRegenerator::regenerate {this class fileDesc tgtModel} {
  239.     if {[$this checkFile $fileDesc]} {
  240.     m4_error $E_OBSOLETESECT [$class getName]
  241.     m4_warning $M_NO_REGEN [$class getName]
  242.     return
  243.     }
  244.  
  245.     $this tgtClass [$tgtModel findDefinition [$class getName]]
  246.     if {[$this tgtClass] == ""} {
  247.     # an error has occurred while GEnerating for this class, REgeneration
  248.     #  is needless
  249.     return
  250.     }
  251.  
  252.     set kind ""
  253.     while {![eof $fileDesc]} {
  254.     set line [gets $fileDesc]
  255.     if {[string match *begin* $line]} {
  256.         if {![regexp {^[- \t]*begin ([^;]+);$} $line dummy kind]} {
  257.         m4_warning $E_ILL_HEADER [$class getName] $line
  258.         m4_warning $M_NO_REGEN [$class getName]
  259.         return
  260.         }
  261.         break
  262.     }
  263.     }
  264.     if {$kind == ""} {
  265.     m4_warning $E_NO_HEADER [$class getName]
  266.     m4_warning $M_NO_REGEN [$class getName]
  267.     return
  268.     }
  269.  
  270.     # only CLASS and CURSOR are regenerated
  271.     #
  272.     if {$kind == "CLASS"} {
  273.     if {[$this hasSameKind $class $kind]} {
  274.         $this processClass $fileDesc
  275.     } else {
  276.         m4_warning $M_NO_REGEN [$class getName]
  277.     }
  278.     } elseif {$kind == "CURSOR"} {
  279.     if {[$this hasSameKind $class $kind]} {
  280.         $this processCursor $fileDesc
  281.     } else {
  282.         m4_warning $M_NO_REGEN [$class getName]
  283.     }
  284.     } else {
  285.     $this hasSameKind $class $kind
  286.     }
  287. }
  288.  
  289. method FTRegenerator::checkFile {this fileDesc} {
  290.     # check whether there is still OBSOLETE CODE in the file
  291.     #
  292.     while {![eof $fileDesc]} {
  293.     set line [gets $fileDesc]
  294.     if {[string match *${FTConstants::obsoleteCode}* $line]} {
  295.         seek $fileDesc 0
  296.         return 1
  297.     }
  298.     }
  299.     
  300.     seek $fileDesc 0
  301.     return 0
  302. }
  303.  
  304. method FTRegenerator::processClass {this fileDesc} {
  305.     set WS "\[ \t]*"
  306.     set WSn "\[ \t]+"
  307.     set state START
  308.     set methInfos [List new]
  309.     while {![eof $fileDesc]} {
  310.     set line [gets $fileDesc]
  311.     if {$state == "START"} {
  312.         if {[regexp "^${WS}class${WSn}" $line]} {
  313.         $this processClassDecl $fileDesc
  314.         set state DEF
  315.         }
  316.     } elseif {[regexp "^${WS}method${WSn}" $line]} {
  317.         set methInfo [$this processClassUserBody $fileDesc $line method]
  318.         if {$methInfo != {}} {
  319.         $methInfos append $methInfo
  320.         }
  321.     } elseif {[regexp "^${WS}event handler${WSn}" $line]} {
  322.         set methInfo [$this processClassUserBody $fileDesc $line event]
  323.         if {$methInfo != {}} {
  324.         $methInfos append $methInfo
  325.         }
  326.     }
  327.     }
  328.     if {![$methInfos empty]} {
  329.     $this processClassUserBodies $methInfos
  330.     }
  331. }
  332.  
  333. method FTRegenerator::processClassDecl {this fileDesc} {
  334.     # class declaration -> props, map
  335.     #
  336.     set WS "\[ \t]*"
  337.     set WSn "\[ \t]+"
  338.     set state START
  339.     while {![eof $fileDesc]} {
  340.     set line [gets $fileDesc]
  341.     if {[regexp "^${WS}end${WS}class${WS};" $line]} {
  342.         return
  343.     } elseif {[regexp "^${WS}$" $line]} {
  344.         continue
  345.     } elseif {[regexp "^${WS}--" $line]} {
  346.         continue
  347.     } elseif {[regexp "^${WS}has${WS}property" $line]} {
  348.         set sect [[[$this tgtClass] sections] getSection property]
  349.         if {$sect != ""} {
  350.         $sect append "$line\n"
  351.         set state PROPS
  352.         }
  353.     } elseif {[regexp "^${WS}has${WS}$" $line]} {
  354.         set sect [[[$this tgtClass] sections] getSection map]
  355.         if {$sect != ""} {
  356.         set state MAP1
  357.         }
  358.     } elseif {[regexp "^\[-+]" $line]} {
  359.         if {$state == "MAP1"} {
  360.         $sect append "has\n"
  361.         set state MAP
  362.         }
  363.         if {$state == "MAP"} {
  364.         $sect append "$line\n"
  365.         }
  366.         if {[regexp "^-" $line]} {
  367.         set state END
  368.         }
  369.     } elseif {$state == "PROPS"} {
  370.         $sect append "$line\n"
  371.     }
  372.     }
  373. }
  374.  
  375. method FTRegenerator::processClassUserBody {this fileDesc line kind} {
  376.     # kind is one of method, event (meaning "event handler")
  377.     # Init -> user sect
  378.     # methods, event handlers -> body
  379.     #
  380.     set signSect [TextSection new]
  381.     $signSect append "$line\n"
  382.  
  383.     set name ""
  384.     set WS "\[ \t]*"
  385.     set kind2 $kind
  386.     if {$kind == "event"} {
  387.     set kind2 "event handler"
  388.     }
  389.     # ^ <kind> <system> '.' <name>
  390.     regexp "^${WS}$kind2${WS}\[^.]+\.(\[_0-9A-Za-z]+)" $line dummy name
  391.  
  392.     set tgtMethods [[$this tgtClass] findMethods $name $kind]
  393.     if {[llength $tgtMethods] == 0} {
  394.     # no method found, make OBSOLETE
  395.     #
  396.     m4_warning $W_OBSOLETECODE [[$this tgtClass] name] $name
  397.     $this makeObsolete $fileDesc $signSect $kind
  398.     return ""
  399.     }
  400.     if {[llength $tgtMethods] == 1 && [[lindex $tgtMethods 0] isGenerated]} {
  401.     # the method that was found, has been generated; we guess that the user
  402.     # did not overload it
  403.     #
  404.     return ""
  405.     }
  406.  
  407.     # special treatment for method 'Init'
  408.     #
  409.     if {$name == "Init"} {
  410.     $this processClassInit $fileDesc [lindex $tgtMethods 0]
  411.     return ""
  412.     }
  413.  
  414.     # create a list of the method's parameter types
  415.     # find out the return type of the method
  416.     #
  417.     set parTypes {}
  418.     set parType ""
  419.     # read 1st param, i.e. '(' <name> ':' <type>
  420.     #   may be followed by '=' or ',' or ')'
  421.     regexp "\\(\[^:)]*:${WS}(\[^=,)]*)" $line dummy parType
  422.     if {[string trim $parType] != ""} {
  423.     lappend parTypes [string trim $parType]
  424.     }
  425.     set methType ""
  426.     if {$kind == "method"} {
  427.     # read method type, i.e. ':' ["copy"] <type>
  428.     regexp ":${WS}(\[^:=,)]*)$" $line dummy methType
  429.     }
  430.  
  431.     set beginLine ""
  432.     set endLine ""
  433.     while {![eof $fileDesc]} {
  434.     set line [gets $fileDesc]
  435.     if {[regexp "^${WS}begin${WS}$" $line]} {
  436.         set beginLine $line
  437.         break
  438.     } elseif {[regexp "^${WS}end${WS}$kind" $line]} {
  439.         set endLine $line
  440.         break
  441.     } else {
  442.         $signSect append "$line\n"
  443.         set parType ""
  444.         # read 2nd param, i.e. <name> ':' <type>
  445.         #   may be followed by '=' or ',' or ')'
  446.         regexp "\[^:)]*:${WS}(\[^=,)]*)" $line dummy parType
  447.         if {[string trim $parType] != ""} {
  448.         lappend parTypes [string trim $parType]
  449.         }
  450.         if {$kind == "method" && $methType == ""} {
  451.         # read method type, i.e. ':' ["copy"] <type>
  452.         regexp ":${WS}(\[^:=,)]*)$" $line dummy methType
  453.         }
  454.     }
  455.     }
  456.     if {$kind == "method"} {
  457.     regsub "${WS}copy${WS}" $methType "" methType
  458.     set methType [string trim $methType]
  459.     }
  460.  
  461.     # now, find a full match
  462.     #
  463.     foreach mx [[$this tgtClass] findMethodsX $name $kind] {
  464.     set meth [lindex $mx 0]
  465.     if {[$meth isGenerated] || [$meth userCode] != ""} {
  466.         continue
  467.     }
  468.  
  469.     set parTypesX [lindex [lindex $mx 1] 0]
  470.     set methTypeX [lindex [lindex $mx 1] 1]
  471.     if {$parTypesX == $parTypes && $methTypeX == $methType} {
  472.         # regenerate
  473.         #
  474.         set sect [$meth getUserCode]
  475.         while {![eof $fileDesc]} {
  476.         set line [gets $fileDesc]
  477.         if {[regexp "^${WS}end${WS}$kind" $line]} {
  478.             break
  479.         } else {
  480.             $sect append "$line\n"
  481.         }
  482.         }
  483.         return ""
  484.     }
  485.     }
  486.  
  487.     # no full match: remember next things
  488.     #
  489.     #        - kind name parTypes methType
  490.     #        - signSect
  491.     #        - beginLine
  492.     #        - bodySect (to be read)
  493.     #        - endLine
  494.     #
  495.     set bodySect [TextSection new]
  496.     if {$endLine == ""} {
  497.     while {![eof $fileDesc]} {
  498.         set line [gets $fileDesc]
  499.         if {[regexp "^${WS}end${WS}$kind" $line]} {
  500.         set endLine $line
  501.         break
  502.         } else {
  503.         $bodySect append "$line\n"
  504.         }
  505.     }
  506.     }
  507.  
  508.     # this is dirty, but hey, what did you expect after the preceding...
  509.     #
  510.     return [list [list $kind $name $parTypes $methType] $signSect $beginLine $bodySect $endLine]
  511. }
  512.  
  513. method FTRegenerator::processClassUserBodies {this methodInfos} {
  514.     # process all methods in the code that have no full match in the model
  515.     #
  516.     set m2Infos [List new]
  517.     $methodInfos foreach mInfo {
  518.     set tmp [lindex $mInfo 0]
  519.     set kind [lindex $tmp 0]
  520.     set name [lindex $tmp 1]
  521.     set parTypes [lindex $tmp 2]
  522.     set methType [lindex $tmp 3]
  523.  
  524.     # find the first full parameter list match
  525.     #
  526.     set found 0
  527.     if {![info exists mxs($name.$kind)]} {
  528.         set mxs($name.$kind) [[$this tgtClass] findMethodsX $name $kind]
  529.     }
  530.     foreach mx $mxs($name.$kind) {
  531.         set meth [lindex $mx 0]
  532.         if {[$meth isGenerated] || [$meth userCode] != ""} {
  533.         continue
  534.         }
  535.  
  536.         set parTypesX [lindex [lindex $mx 1] 0]
  537.         if {$parTypesX == $parTypes} {
  538.         $this makeOldCode $meth $mInfo $mx
  539.         set found 1
  540.         break
  541.         }
  542.     }
  543.     if {!$found} {
  544.         $m2Infos append $mInfo
  545.     }
  546.     }
  547.  
  548.     set m3Infos [List new]
  549.     $m2Infos foreach mInfo {
  550.     set tmp [lindex $mInfo 0]
  551.     set kind [lindex $tmp 0]
  552.     set name [lindex $tmp 1]
  553.     set parTypes [lindex $tmp 2]
  554.     set methType [lindex $tmp 3]
  555.  
  556.     # find the first return type match
  557.     #
  558.     set found 0
  559.     foreach mx $mxs($name.$kind) {
  560.         set meth [lindex $mx 0]
  561.         if {[$meth isGenerated] || [$meth userCode] != ""} {
  562.         continue
  563.         }
  564.  
  565.         set methTypeX [lindex [lindex $mx 1] 1]
  566.         if {$methTypeX == $methType} {
  567.         $this makeOldCode $meth $mInfo $mx
  568.         set found 1
  569.         break
  570.         }
  571.     }
  572.     if {!$found} {
  573.         $m3Infos append $mInfo
  574.     }
  575.     }
  576.  
  577.     $m3Infos foreach mInfo {
  578.     set tmp [lindex $mInfo 0]
  579.     set kind [lindex $tmp 0]
  580.     set name [lindex $tmp 1]
  581.     set parTypes [lindex $tmp 2]
  582.     set methType [lindex $tmp 3]
  583.  
  584.     # get the first available method
  585.     #
  586.     set found 0
  587.     foreach mx $mxs($name.$kind) {
  588.         set meth [lindex $mx 0]
  589.         if {[$meth isGenerated] || [$meth userCode] != ""} {
  590.         continue
  591.         }
  592.  
  593.         $this makeOldCode $meth $mInfo $mx
  594.         set found 1
  595.         break
  596.     }
  597.     if {!$found} {
  598.         # no method found: make OBSOLETE
  599.         #
  600.         set name "$name\($parTypes)"
  601.         if {$methType != ""} {
  602.         set name "$name: $methType"
  603.         }
  604.         m4_warning $W_OBSOLETECODE [[$this tgtClass] name] $name
  605.         set sect [[[$this tgtClass] sections] getSection obsolete]
  606.         if {$sect != ""} {
  607.         $sect appendSect [lindex $mInfo 1]
  608.         $sect append "[lindex $mInfo 2]\n"
  609.         $sect appendSect [lindex $mInfo 3]
  610.         $sect append "[lindex $mInfo 4]\n"
  611.         $sect append "\n"
  612.         }
  613.     }
  614.     }
  615. }
  616.  
  617. method FTRegenerator::processClassInit {this fileDesc tgtMethod} {
  618.     set sect ""
  619.     set WS "\[ \t]*"
  620.     set state START
  621.     while {![eof $fileDesc]} {
  622.     set line [gets $fileDesc]
  623.     if {[regexp "^${WS}end${WS}method" $line]} {
  624.         return
  625.     } elseif {[string match *${FTConstants::startCtor} $line]} {
  626.         set state COPY
  627.     } elseif {[string match *${FTConstants::endCtor} $line]} {
  628.         return
  629.     } elseif {$state == "COPY"} {
  630.         if {$sect == ""} {
  631.         set sect [$tgtMethod getUserCode]
  632.         }
  633.         $sect append "$line\n"
  634.     }
  635.     }
  636. }
  637.  
  638. method FTRegenerator::processCursor {this fileDesc} {
  639.     # all lines between "begin" and the final "end;" line will be regenerated
  640.     #
  641.     set tgtMethod [[[$this tgtClass] methSet] index 0]
  642.     set sect ""
  643.     set WS "\[ \t]*"
  644.     set state START
  645.     while {![eof $fileDesc]} {
  646.     set line [gets $fileDesc]
  647.     if {$state == "START"} {
  648.         if {[regexp "^${WS}begin${WS}$" $line]} {
  649.         set state BODY
  650.         }
  651.     } elseif {[regexp "^${WS}end${WS};${WS}$" $line]} {
  652.         if {$state == "BODY"} {
  653.         set state OPT_BODY
  654.         } else {
  655.         # state == OPT_BODY
  656.         $sect appendSect $optSect
  657.         }
  658.         set optSect [TextSection new]
  659.         $optSect append "$line\n"
  660.     } elseif {$state == "BODY"} {
  661.         if {$sect == ""} {
  662.         set sect [$tgtMethod getUserCode]
  663.         }
  664.         $sect append "$line\n"
  665.     } else {
  666.         # state == OPT_BODY
  667.         $optSect append "$line\n"
  668.     }
  669.     }
  670. }
  671.  
  672. method FTRegenerator::makeOldCode {this method codeInfo modelInfo} {
  673.     # generate OLDCODE
  674.     #
  675.     set tmp [lindex $codeInfo 0]
  676.     set kind [lindex $tmp 0]
  677.     set name [lindex $tmp 1]
  678.     set parTypes [lindex $tmp 2]
  679.     set methType [lindex $tmp 3]
  680.     set cname "$name\($parTypes)"
  681.     if {$methType != ""} {
  682.     set cname "$cname: $methType"
  683.     }
  684.     set mname "$name\([lindex [lindex $modelInfo 1] 0])"
  685.     set methType [lindex [lindex $modelInfo 1] 1]
  686.     if {$methType != ""} {
  687.     set mname "$mname: $methType"
  688.     }
  689.     m4_warning $W_OLDCODE [[$this tgtClass] name] $cname $mname $kind
  690.     $method hasOldCode 1
  691.     set sect [$method getUserCode]
  692.     $sect appendSect [lindex $codeInfo 3]
  693. }
  694.  
  695. method FTRegenerator::makeObsolete {this fileDesc methSect kind} {
  696.     set sect [[[$this tgtClass] sections] getSection obsolete]
  697.     if {$sect == ""} {
  698.     return
  699.     }
  700.     $sect appendSect $methSect
  701.     set WS "\[ \t]*"
  702.     while {![eof $fileDesc]} {
  703.     set line [gets $fileDesc]
  704.     $sect append "$line\n"
  705.     if {[regexp "^${WS}end${WS}$kind" $line]} {
  706.         break
  707.     }
  708.     }
  709.     $sect append "\n"
  710. }
  711.  
  712. method FTRegenerator::hasSameKind {this class kind} {
  713.     if {$kind == [[$this tgtClass] kind]} {
  714.     return 1
  715.     }
  716.  
  717.     m4_warning $W_KIND_CHANGE [$class getName] $kind [[$this tgtClass] kind]
  718.     return 0
  719. }
  720.  
  721. # Do not delete this line -- regeneration end marker
  722.  
  723.