home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / pbgentor.tcl < prev    next >
Encoding:
Text File  |  1997-05-30  |  42.8 KB  |  1,469 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            : pbgentor.tcl
  17. #       Author          : 
  18. #       Original date   : May 1997
  19. #       Description     : Classes for code generation
  20. #
  21. #---------------------------------------------------------------------------
  22.  
  23. #---------------------------------------------------------------------------
  24. #      File:           @(#)pbfilehand.tcl    /main/hindenburg/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 PBFileHandler : {FileHandler} {
  33.     constructor
  34.     method destructor
  35.     method getFileTypes
  36.     method getSpecialFiles
  37.     method setImpFrom
  38.     attribute srwType
  39.     attribute srmType
  40.     attribute srsType
  41.     attribute sruType
  42. }
  43.  
  44. constructor PBFileHandler {class this} {
  45.     set this [FileHandler::constructor $class $this]
  46.     $this srwType "window"
  47.     $this srmType "menu"
  48.     $this srsType "structure"
  49.     $this sruType "userobject"
  50.     # Start constructor user section
  51.     # End constructor user section
  52.     return $this
  53. }
  54.  
  55. method PBFileHandler::destructor {this} {
  56.     # Start destructor user section
  57.     # End destructor user section
  58.     $this FileHandler::destructor
  59. }
  60.  
  61. method PBFileHandler::getFileTypes {this} {
  62.     set list [List new]
  63.  
  64.     $list append [$this srwType]
  65.     $list append [$this srmType]
  66.     $list append [$this srsType]
  67.     $list append [$this sruType]
  68.  
  69.     return $list
  70. }
  71.  
  72. method PBFileHandler::getSpecialFiles {this} {
  73.     return [List new]
  74. }
  75.  
  76. method PBFileHandler::setImpFrom {this fileName class} {
  77.     $this FileHandler::setImpFrom $fileName $class
  78. }
  79.  
  80. # Do not delete this line -- regeneration end marker
  81.  
  82. #---------------------------------------------------------------------------
  83. #      File:           @(#)pbgenerato.tcl    /main/hindenburg/2
  84. #---------------------------------------------------------------------------
  85.  
  86. # Start user added include file section
  87. # End user added include file section
  88.  
  89. require "generator.tcl"
  90.  
  91. Class PBGenerator : {Generator} {
  92.     constructor
  93.     method destructor
  94.     method generate
  95. }
  96.  
  97. constructor PBGenerator {class this} {
  98.     set this [Generator::constructor $class $this]
  99.     # Start constructor user section
  100.     # End constructor user section
  101.     return $this
  102. }
  103.  
  104. method PBGenerator::destructor {this} {
  105.     # Start destructor user section
  106.     # End destructor user section
  107.     $this Generator::destructor
  108. }
  109.  
  110. method PBGenerator::generate {this classList} {
  111.     set typeToClassDictionary [Dictionary new]
  112.     set pbModel [PBModel new]
  113.     set regenerator [PBRegenerator new]
  114.     set fileHandler [PBFileHandler new]
  115.  
  116.     $classList foreach class {
  117.         if ![$class isGlobalType] {
  118.             continue
  119.         }
  120.         set pbdefinition [$class generate $pbModel]
  121.         if {$pbdefinition == ""} {
  122.             continue
  123.         }
  124.         set entry [$pbdefinition libraryEntry]
  125.         if {$entry == ""} {
  126.             continue
  127.         }
  128.         set fileType [$entry getFileType]
  129.         set fileDesc [$fileHandler openFile $class $fileType]
  130.         if {$fileDesc != ""} {
  131.             $regenerator regenerate $entry $fileDesc
  132.             $fileHandler closeFile $fileDesc
  133.         }
  134.     }
  135.  
  136.     $pbModel generate $typeToClassDictionary
  137.     return $typeToClassDictionary
  138. }
  139.  
  140. # Do not delete this line -- regeneration end marker
  141.  
  142. #---------------------------------------------------------------------------
  143. #      File:           @(#)pbregenera.tcl    /main/hindenburg/31
  144. #---------------------------------------------------------------------------
  145.  
  146. # Start user added include file section
  147.  
  148. # End user added include file section
  149.  
  150. require "regenerato.tcl"
  151.  
  152. Class PBRegenerator : {Regenerator} {
  153.     constructor
  154.     method destructor
  155.     method regenerate
  156.     method checkEntryFiles
  157.     method processFile
  158.     method processForward
  159.     method processType
  160.     method skipType
  161.     method processVariables
  162.     method skipVariables
  163.     method processPrototypes
  164.     method processStructure
  165.     method processEntryStructure
  166.     method processEvent
  167.     method skipEvent
  168.     method processFunction
  169.     method skipFunction
  170.     method processSubroutine
  171.     method skipSubroutine
  172.     method processBinaryData
  173.     method skipBinaryData
  174.     method processOn
  175.     method skipOn
  176.     method processOnCreate
  177.     method processOnDestroy
  178.     method processParameter
  179.     attribute currentClass
  180.     attribute currentEntry
  181.     attribute obsolete
  182.     attribute pbdebug
  183. }
  184.  
  185. constructor PBRegenerator {class this} {
  186.     set this [Regenerator::constructor $class $this]
  187.     # Start constructor user section
  188.     $this pbdebug 0
  189.     # End constructor user section
  190.     return $this
  191. }
  192.  
  193. method PBRegenerator::destructor {this} {
  194.     # Start destructor user section
  195.  
  196.     # End destructor user section
  197.     $this Regenerator::destructor
  198. }
  199.  
  200. method PBRegenerator::regenerate {this entry fileDesc} {
  201.     $this currentEntry $entry
  202.     
  203.     $this obsolete 0
  204.     
  205.     set oldFileDesc $fileDesc
  206.     
  207.     $this currentClass [[$this currentEntry] globalDefinition]
  208.     
  209.     # All functions return True (!= 0) if syntax is correctly ended. 
  210.     # This allows checking of an not correctly terminated file.
  211.     
  212.     # if obsolete code is present then stop
  213.     if { ![$this checkEntryFiles $entry $fileDesc]} {
  214.         return 0
  215.     }
  216.     
  217.     # process file:
  218.     
  219.        set line [gets $fileDesc]
  220.     if { [regexp {^(| *)\$PBExportHeader\$(.*)} $line total dummy entryFileName] } {
  221.         set line [gets $fileDesc]
  222.     }
  223.     if { [regexp {^(| *)\$PBExportComments\$(.*)} $line total dummy entryComment] } {
  224.         [$this currentEntry] exportComments $entryComment
  225.         set line [gets $fileDesc]
  226.     }
  227.     if { [regexp {^(| *)forward(.*|)} $line total] } {
  228.  
  229.         $this processForward [$this currentEntry] $fileDesc
  230.     }
  231.  
  232.     while { ![eof $fileDesc] } {
  233.         set line [gets $fileDesc]
  234.         if { [regexp {^(| *)global type ([^ ]*) from ([^ ]*) *}\
  235.                 $line total dummy type from] } {
  236.             # when called correctly the type corresponds with currentEntry!
  237.             # if unsure a name comparison CAN be done
  238.             $this currentClass [[$this currentEntry] globalDefinition]
  239.             [$this currentClass] isRegenerated 1
  240.  
  241.             if {[string tolower $from] == "structure"} {
  242.                 # process type body and add variables to body of entry
  243.                 set ret [$this processStructure [$this currentClass] $fileDesc]            
  244.             } else {
  245.                 # process type body and add variables to body of entry
  246.                 set ret [$this processType [$this currentClass] $fileDesc]
  247.             }
  248.         } elseif { [regexp {^(| *)global ([^ ]*) ([^ ]*) *}\
  249.                 $line total dummy type name] } {
  250.             # just to be on the save side
  251.             $this currentClass [[$this currentEntry] globalDefinition]
  252.             [$this currentClass] isRegenerated 1
  253.         } elseif { [regexp {^(| *)type variables[ ]*} $line total] } {
  254.             # first get vars TextSection
  255.             if { [[$this currentClass] isA "PBClass"] } {
  256.                 if { [[$this currentClass] nonModeledInstanceVars] != "" } {
  257.                     set vars [[$this currentClass] nonModeledInstanceVars] 
  258.                 } else {
  259.                     set vars [TextSection new]
  260.                     [$this currentClass] nonModeledInstanceVars $vars
  261.                 }
  262.                 if { [[$this currentClass] nonModeledInstanceVars] == "" } {
  263.                 }
  264.                 set ret [$this processVariables $vars $fileDesc]
  265.             } else {
  266.                 # currentClass cannot contain instance vars though it is present
  267.                 m4_warning $W_OBSOLVARS [[$this currentClass] name]
  268.                 $this obsolete 1
  269.                 set ret [$this skipVariables $fileDesc]
  270.                 if { ! $ret } {
  271.                         m4_error $E_ENDEXPECT "instance variables" [[$this currentClass] name]
  272.                     }
  273.             }        
  274.         } elseif { [regexp {^(| *)shared variables.*} $line total] } {
  275.  
  276.             # shared variables are part of entry, so set currentClass to given entry:
  277.             $this currentClass [[$this currentEntry] globalDefinition]
  278.             # first get vars TextSection
  279.             if { [[$this currentClass] isA "PBClass"] } {
  280.                 if { [[$this currentClass] nonModeledSharedVars] != "" } {
  281.                     set vars [[$this currentClass] nonModeledSharedVars] 
  282.                 } else {
  283.                     set vars [TextSection new]
  284.                     [$this currentClass] nonModeledSharedVars $vars
  285.                 }
  286.                 if { [[$this currentClass] nonModeledSharedVars] == "" } {
  287.                 }
  288.                 set ret [$this processVariables $vars $fileDesc]
  289.             } else {
  290.                 # currentClass cannot contain instance vars though it is present
  291.                 m4_warning $W_OBSOLVARS [[$this currentClass] name]
  292.                 $this obsolete 1
  293.                 set ret [$this skipVariables $fileDesc]
  294.                 if { ! $ret } {
  295.                         m4_error $E_ENDEXPECT "variables" [[$this currentClass] name]
  296.                     }
  297.             }
  298.         } elseif { [regexp {^(| *)forward prototypes.*} $line total] } {
  299.             set ret [$this processPrototypes [$this currentClass] $fileDesc]
  300.         } elseif { [regexp {^(| *)type ([^ ]*) from ([^ ]*) within ([^ ]*)(| | .*)}\
  301.                         $line total dummy name from within] } {
  302.             # first find corresponding class (recursively)
  303.             if { [[[$this currentEntry] globalDefinition] isA "PBVisualContainer"] } {
  304.                 $this currentClass [[[$this currentEntry] globalDefinition] \
  305.                         findContainedClass $name 1]
  306.                 if {[$this currentClass] != ""} {
  307.                     [$this currentClass] isRegenerated 1
  308.                     set ret [$this processType [$this currentClass] $fileDesc]
  309.                 } else {
  310.                     # object is gone
  311.                     m4_warning $W_OBSOLPROPS $name
  312.                     $this obsolete 1
  313.                     set ret [$this skipType $fileDesc]
  314.                 }
  315.             } else {
  316.                 # a contained class is found but cannot be inserted
  317.                 m4_warning $W_OBSOLCLASSENTRY $name [[$this currentEntry] getName]
  318.                 $this obsolete 1
  319.                 set ret [$this skipType $fileDesc]
  320.             }
  321.         } elseif { [regexp {^ *type ([^ ]*) *from *([^ ]*)(| | .*)}\
  322.                 $line total name from] } {
  323.             if { [string tolower $from] == "structure" } {
  324.                 # if a structure then do nothing, inserted by generator
  325.                 set ret [$this skipType $fileDesc]
  326.             } elseif { [[[$this currentEntry] globalDefinition] isA "PBVisualContainer"] } {
  327.                 # first find corresponding class (recursively)
  328.                 $this currentClass [[[$this currentEntry] globalDefinition] \
  329.                         findContainedClass $name 1]
  330.                 if {[$this currentClass] != ""} {
  331.                     [$this currentClass] isRegenerated 1
  332.                     set ret [$this processType [$this currentClass] $fileDesc]
  333.                 } else {
  334.                     # object is gone
  335.                     m4_warning $W_OBSOLPROPS $name
  336.                     $this obsolete 1
  337.                     set ret [$this skipType $fileDesc]
  338.                     if { ! $ret } {
  339.                         m4_error $E_ENDEXPECT "type" $name
  340.                     }
  341.                 }
  342.             } else {
  343.                 # a contained class is found but cannot be inserted
  344.                 m4_warning $W_OBSOLCLASSENTRY $name [[$this currentEntry] getName]
  345.                 $this obsolete 1
  346.                 set ret [$this skipType $fileDesc]
  347.                 if { ! $ret } {
  348.                     m4_error $E_ENDEXPECT "type" [[$this currentClass] name]
  349.                 }
  350.             }
  351.         } elseif { [regexp {^ *event *([^ ]*) *; *(call[^;]*;|)(.*)$}\
  352.                 $line total name callSuper methLine e1 e2] } {
  353.             # first check for association method
  354.             if { [regexp "^ *${PBCookie::associationAccessorMethod}" $methLine] } {
  355.                 # association
  356.                 set ret [$this skipEvent $fileDesc]
  357.             } elseif { [$this currentClass] == "" } {
  358.                 $this obsolete 1
  359.                 set ret [$this skipEvent $fileDesc]            
  360.             } else {
  361.                 set body ""
  362.                 # first find corresponding function
  363.                 # so check whether it can have functions:
  364.                 if { ![[$this currentClass] isA "PBClass"] } {
  365.                     # currentClass cannot contain events though it is present
  366.                     m4_warning $W_OBSOLEVENTCLASS $name [[$this currentClass] name]
  367.                     $this obsolete 1
  368.                     set ret [$this skipEvent $fileDesc]
  369.                 } else {
  370.                     set event [[$this currentClass] findEvent $name]
  371.                     if { $event  != "" } {
  372.                         # perfect matching method, if it has a body then move this body to
  373.                         # another method (check function, not the events (no event overloading))
  374.                         if { [$event body] != ""} {
  375.                             # body is already filled, although this was perfect match, so find
  376.                             # other and move body to other matching function (by name only)
  377.                             set body [$event body]
  378.                             set func [[$this currentClass] matchObjectFunction $name]
  379.                             if {$func != ""} {
  380.                                 # matchOF already checks for empty bodies
  381.                                 m4_warning $W_OLDMETHOD $name [[$this currentClass] name]
  382.                                 $func body $body
  383.                             } else {
  384.                                 # nothing suitable found: all already filled, or no
  385.                                 # matching names
  386.                                 m4_warning $W_OBSOLEVENT $name [[$this currentClass] name]
  387.                                 $this obsolete 1
  388.                             }
  389.                         }
  390.                         set body [TextSection new]
  391.                         $event body $body
  392.                         if { $callSuper != "" } {
  393.                             $event extendAncestorScript 1
  394.                         }
  395.                     } else {
  396.                         # find a matching function and store code in this body preceding a comment line
  397.                         # not find a event (no overloading)
  398.                         set func [[$this currentClass] matchObjectFunction $name]
  399.                         if {$func != ""} {
  400.                             # matchOF already checks for empty bodies
  401.                             set body [TextSection new]
  402.                             m4_warning $W_OLDMETHOD $name [[$this currentClass] name]
  403.                             $func body $body
  404.                             $body append {// Old code section}
  405.                             $body append "\n"
  406.                         } else {
  407.                             # nothing suitable found: all already filled, or no
  408.                             # matching names
  409.                             m4_warning $W_OBSOLEVENT $name [[$this currentClass] name]
  410.                             $this obsolete 1
  411.                         }
  412.                     }
  413.                     # if a body set then there was some match, and now fill body.
  414.                     if { $body != "" } {
  415.                         # processEvent checks association methods (and skip those)
  416.                         set ret [$this processEvent $body $fileDesc $methLine]
  417.                     } else {
  418.                         # obsolete code user defined
  419.                         m4_warning $W_OBSOLEVENT $name [[$this currentClass] name]
  420.                         $this obsolete 1
  421.                         set ret [$this skipEvent $fileDesc]
  422.                     }
  423.                 }
  424.             }
  425.             # generate syntax error if ret is false 
  426.             if { ! $ret } {
  427.                 m4_error $E_ENDEXPECTMETHOD "event" $name [[$this currentClass] name]
  428.             }
  429.         } elseif { [regexp {^ *(|[^ ]* )function ([^ ]*) ([^ ]*) (\([^);]*\)) *; *(.*)$}\
  430.                 $line total access type name args methLine] } {
  431.             # obsolete code when not a association
  432.             if { [regexp "^ *${PBCookie::associationAccessorMethod}" $methLine] } {
  433.                 # association
  434.                 set ret [$this skipFunction $fileDesc]
  435.             } elseif { [$this currentClass] == "" } {
  436.                 $this obsolete 1
  437.                 set ret [$this skipFunction $fileDesc]            
  438.             } else {
  439.                 set body ""
  440.                 # first find corresponding function
  441.                 # so check whether it can have functions:
  442.                 if { ![[$this currentClass] isA "PBClass"] } {
  443.                     # currentEntry cannot contain functions though it is present
  444.                     m4_warning $W_OBSOLFUNCTCLASS $name [[$this currentClass] name]
  445.                     $this obsolete 1
  446.                     set ret [$this skipFunction $fileDesc]
  447.                 } else {
  448.                     # generate parameter list for finding correct function (overloading)
  449.                     set paramList [$this processParameter $args]
  450.                     set function [[$this currentClass] findObjectFunction $name $paramList]
  451.                     if { $function != "" } {
  452.                         # perfect matching method, if it has a body then move this body to
  453.                         # another method (first check function then events
  454.                         if { [$function body] != ""} {
  455.                             # body is already filled, although this was perfect match, so find
  456.                             # other and move body to other matching function (by name only)
  457.                             set body [$function body]
  458.                             set func [[$this currentClass] matchObjectFunction $name]
  459.                             if {$func != ""} {
  460.                                 # matchOF already checks for empty bodies
  461.                                 $func body $body
  462.                             } else {
  463.                                 set event [[$this currentClass] matchEvent $name]
  464.                                 if {$event != ""} {
  465.                                     # matchE already checks for empty bodies
  466.                                     $event body $body
  467.                                 } else {
  468.                                     # nothing suitable found: all already filled, or no
  469.                                     # matching names
  470.                                     m4_warning $W_OBSOLMETHOD $name [[$this currentClass] name]
  471.                                     $this obsolete 1
  472.                                 }
  473.                             }
  474.                         }
  475.                         set body [TextSection new]
  476.                         $function body $body
  477.                     } else {
  478.                         # find a matching and store code in this body preceding a comment line
  479.                         set func [[$this currentClass] matchObjectFunction $name]
  480.                         if {$func != ""} {
  481.                             # matchOF already checks for empty bodies
  482.                             set body [TextSection new]
  483.                             m4_warning $W_OLDMETHOD $name [[$this currentClass] name]
  484.                             $func body $body
  485.                             $body append {// Old code section}
  486.                             $body append "\n"
  487.                         } else {
  488.                             set event [[$this currentClass] matchEvent $name]
  489.                             if {$event != ""} {
  490.                                 # matchE already checks for empty bodies
  491.                                 m4_warning $W_OLDMETHOD $name [[$this currentClass] name]
  492.                                 set body [TextSection new]
  493.                                 $event body $body
  494.                                 $body append {// Old code section}
  495.                                 $body append "\n"
  496.                             } else {
  497.                                 # nothing suitable found: all already filled, or no
  498.                                 # matching names
  499.                                 m4_warning $W_OBSOLFUNCT $name [[$this currentClass] name]
  500.                                 $this obsolete 1
  501.                             }
  502.                         }
  503.                     }
  504.                     # if a body set then there was some match, and now fill body.
  505.                     if { $body != "" } {
  506.                         # processFunction checks association methods (and skip those)
  507.                         set ret [$this processFunction $body $fileDesc $methLine]
  508.                     } else {
  509.                         # obsolete code, user defined
  510.                         $this obsolete 1
  511.                         set ret [$this skipFunction $fileDesc]
  512.                     }
  513.                 }
  514.             }
  515.             # generate syntax error if ret is false 
  516.             if { ! $ret } {
  517.                 m4_error $E_ENDEXPECTMETHOD "function" $name [[$this currentClass] name]
  518.             }
  519.         } elseif { [regexp {^ *(|[^ ]* )subroutine ([^ ]*) (\([^);]*\)) *; *(.*)$}\
  520.                        $line total access name args methLine] } {
  521.             # first check for association method
  522.             if { [regexp "^ *${PBCookie::associationAccessorMethod}" $methLine] } {
  523.                 # association
  524.                 set ret [$this skipSubroutine $fileDesc]        
  525.             } elseif { [$this currentClass] == "" } {
  526.                 $this obsolete 1
  527.                 set ret [$this skipSubroutine $fileDesc]            
  528.             } else {            
  529.                 set body ""
  530.                 # first find corresponding function
  531.                 # so check whether it can have functions:
  532.                 if { ![[$this currentClass] isA "PBClass"] } {
  533.                     # currentEntry cannot contain functions though it is present
  534.                     m4_warning $W_OBSOLSUBRTCLASS $name [[$this currentClass] name]
  535.                     $this obsolete 1
  536.                     set ret [$this skipSubroutine $fileDesc]
  537.                 } else {
  538.                     # generate parameter list for finding correct function (overloading)
  539.                     set paramList [$this processParameter $args]
  540.                     set function [[$this currentClass] findObjectFunction $name $paramList]
  541.                     if { $function != "" } {
  542.                         # perfect matching method, if it has a body then move this body to
  543.                         # another method (first check function then events
  544.                         if { [$function body] != ""} {
  545.                             # body is already filled, although this was perfect match, so find
  546.                             # other and move body to other matching function (by name only)
  547.                             set body [$function body]
  548.                             set func [[$this currentClass] matchObjectFunction $name]
  549.                             if {$func != ""} {
  550.                                 # matchOF already checks for empty bodies
  551.                                 $func body $body
  552.                             } else {
  553.                                 set event [[$this currentClass] matchEvent $name]
  554.                                 if {$event != ""} {
  555.                                     # matchE already checks for empty bodies
  556.                                     $event body $body
  557.                                 } else {
  558.                                     # nothing suitable found: all already filled, or no
  559.                                     # matching names
  560.                                     m4_warning $W_OBSOLMETHOD $name [[$this currentClass] name]
  561.                                     $this obsolete 1
  562.                                 }
  563.                             }
  564.                         }
  565.                         set body [TextSection new]
  566.                         $function body $body
  567.                     } else {
  568.                         # find a matching and store code in this body preceding a comment line
  569.                         set func [[$this currentClass] matchObjectFunction $name]
  570.                         if {$func != ""} {
  571.                             # matchOF already checks for empty bodies
  572.                             set body [TextSection new]
  573.                             m4_warning $W_OLDMETHOD $name [[$this currentClass] name]
  574.                             $func body $body
  575.                             $body append {// Old code section}
  576.                             $body append "\n"
  577.                         } else {
  578.                             set event [[$this currentClass] matchEvent $name]
  579.                             if {$event != ""} {
  580.                                 # matchE already checks for empty bodies
  581.                                 m4_warning $W_OLDMETHOD $name [[$this currentClass] name]
  582.                                 set body [TextSection new]
  583.                                 $event body $body
  584.                                 $body append {// Old code section}
  585.                                 $body append "\n"
  586.                             } else {
  587.                                 # nothing suitable found: all already filled, or no
  588.                                 # matching names
  589.                                 m4_warning $W_OBSOLSUBRT $name [[$this currentClass] name]
  590.                                 $this obsolete 1
  591.                             }
  592.                         }
  593.                     }
  594.                     # if a body set then there was some match, and now fill body.
  595.                     if { $body != "" } {
  596.                         # processSubroutine checks association methods (and skip those)
  597.                         set ret [$this processSubroutine $body $fileDesc $methLine]
  598.                     } else {
  599.                         # obsolete code user defined
  600.                         $this obsolete 1
  601.                         set ret [$this skipSubroutine $fileDesc]
  602.                     }
  603.                 }
  604.             }
  605.             # generate syntax error if ret is false 
  606.             if { ! $ret } {
  607.                 m4_error $E_ENDEXPECTMETHOD "subroutine" $name [[$this currentClass] name]
  608.             }
  609.         } elseif { [regexp {^(| *)on ([^ .]*)\.([^ ]*) *$} $line total dummy class name ] } {
  610.             # first find corresponding class as defined by class in on
  611.             if { [$this currentClass] != "" } {
  612.                 if { [[$this currentClass] name] == $class } {
  613.                     set onClass [$this currentClass]
  614.                 } else {
  615.                     set onClass [[[$this currentEntry] globalDefinition] findContainedClass $name 1]
  616.                 }
  617.             } else {
  618.                 set onClass [[[$this currentEntry] globalDefinition] findContainedClass $name 1]
  619.             }        
  620.             if { $onClass == "" } {
  621.                 # onClass not present
  622.                 m4_warning $W_OBSOLMETHCONTR $name $class
  623.                 $this obsolete 1
  624.                 set ret [$this skipOn $fileDesc]
  625.                 if { ! $ret } {
  626.                     m4_error $E_ENDEXPECTMETHOD "on" $name $class
  627.                 }            
  628.             } else {
  629.                 # first find corresponding function
  630.                 # so check whether it can have functions:
  631.                 if { [$onClass isA "PBClass"] } {
  632.                     if { [string tolower $name] == "destroy" } {
  633.                         set methLine ""
  634.                         if { [$onClass isA "PBVisual"] } {
  635.                             # only Visual class has an extensive destroy section
  636.                             set ret [$this processOnDestroy $onClass $fileDesc $methLine]
  637.                         } else {
  638.                             set ret [$this skipOn $fileDesc]
  639.                         }
  640.                         
  641.                         if { ! $ret } {
  642.                             m4_error $E_ENDEXPECTMETHOD "on" $name [$onClass name]
  643.                         }
  644.                     } elseif { [string tolower $name] == "create" } {
  645.                         set methLine ""
  646.                         if { [$onClass isA "PBVisual"] } {
  647.                             # only Visual class has an extensive create section
  648.                             set ret [$this processOnCreate $onClass $fileDesc $methLine]
  649.                         } else {
  650.                             set ret [$this skipOn $fileDesc]
  651.                         }
  652.                         if { ! $ret } {
  653.                             m4_error $E_ENDEXPECTMETHOD "on" $name [$onClass name]
  654.                         }
  655.                     } else {
  656.                         # this is a on event (hopefully)
  657.                         set event [onClass findEvent $name]
  658.                         if { $event != "" } {
  659.                             if { [$event body] } {
  660.                                 set body [$event body] 
  661.                             } else {
  662.                                 set body [TextSection new]
  663.                                 $event body $body
  664.                             }
  665.                             set ret [$this processOn $body $fileDesc $methLine ]
  666.                             if { ! $ret } {
  667.                                 m4_error $E_ENDEXPECTMETHOD "on" $name [$onClass name]
  668.                             }
  669.                         } else {
  670.                             # obsolete code
  671.                             m4_warning $W_OBSOLON $name [$onClass name]
  672.                             $this obsolete 1
  673.                             set ret [$this skipOn $fileDesc]
  674.                             # generate syntax error if ret is false 
  675.                             if { ! $ret } {
  676.                                 m4_error $E_ENDEXPECTMETHOD "on" $name [$onClass name]
  677.                             }
  678.                         }
  679.                     }
  680.                 } else {
  681.                     # currentClass cannot contain events though it is present
  682.                     m4_warning $W_OBSOLONCLASS $name [$onClass name]
  683.                     $this obsolete 1
  684.                     set ret [$this skipOn $fileDesc]
  685.                     if { ! $ret } {
  686.                         m4_error $E_ENDEXPECTMETHOD "on" $name [$onClass name]
  687.                     }
  688.                 }
  689.             }
  690.         } elseif { [regexp {^ *on ([^ ;]*) *;(.*)$} $line total name methLine] } {
  691.  
  692.             # first find corresponding event
  693.             # so check whether it can have functions:
  694.             if { [$this currentClass] == "" } {
  695.                 $this obsolete 1
  696.                 set ret [$this skipOn $fileDesc]            
  697.             } elseif { [[$this currentClass] isA "PBClass"] } {
  698.                 set event [[$this currentClass] findEvent $name]
  699.                 if { $event != "" } {
  700.                     if { [$event body] != ""} {
  701.                         set body [$event body] 
  702.                     } else {
  703.                         set body [TextSection new]
  704.                         $event body $body
  705.                     }
  706.                     set ret [$this processOn $body $fileDesc $methLine]
  707.                     
  708.                     # generate syntax error if ret is false 
  709.                 if { ! $ret } {
  710.                         m4_error $E_ENDEXPECTMETHOD "on" $name [[$this currentClass] name]
  711.                     }
  712.                 } else {
  713.                     # obsolete code
  714.                     m4_warning $W_OBSOLON $name [[$this currentClass] name]
  715.                     $this obsolete 1
  716.                     set ret [$this skipOn $fileDesc]
  717.                     # generate syntax error if ret is false 
  718.                     if { ! $ret } {
  719.                         m4_error $E_ENDEXPECTMETHOD "on" $name [[$this currentClass] name]
  720.                     }
  721.                 }
  722.             } else {
  723.                 # currentClass cannot contain events though it is present
  724.                 m4_warning $W_OBSOLONCLASS $name [[$this currentClass] name]
  725.                 $this obsolete 1
  726.                 set ret [$this skipOn $fileDesc]
  727.             }
  728.             # generate syntax error if ret is false
  729.             if { [$this currentClass] == "" } {
  730.                 set $tmp ""
  731.             } else {
  732.                 set $tmp [[$this currentClass] name]
  733.             }        
  734.             if { ! $ret } {
  735.                 m4_error $E_ENDEXPECTMETHOD "on" $name $tmp
  736.             }    
  737.         } elseif { [regexp "^ *${PBCookie::startBinaryDataSection}.*"\
  738.                 $line total name methLine] } {
  739.             # first find corresponding event
  740.             # so check whether it can have functions:
  741.             $this currentClass [[$this currentEntry] globalDefinition]
  742.             if { [[$this currentClass] isA "PBVisualContainer"] } {
  743.                 if { [$this currentClass] binaryData != "" } {
  744.                     set binaryData [[$this currentClass] binaryData]
  745.                 } else {
  746.                     set binaryData [TextSection new]
  747.                     [$this currentClass] binaryData $body
  748.                 }
  749.                 set ret [$this processBinaryData $binaryData $fileDesc]
  750.                 # generate syntax error if ret is false 
  751.                 if { ! $ret } {
  752.                     m4_error $E_ENDEXPECTBINARY [[$this currentClass] name]
  753.                 }
  754.             } else {
  755.                 # currentClass cannot contain events though it is present
  756.                 m4_warning $W_OBSOLBINARY [[$this currentClass] name]
  757.                 $this obsolete 1
  758.                 set ret [$this skipBinaryData $fileDesc]
  759.                 if { ! $ret } {
  760.                     m4_error $E_ENDEXPECTBINARY [[$this currentClass] name]
  761.                 }
  762.             }
  763.         } elseif { [regexp {^ *$} $line] } {
  764.             set ret 1
  765.         } else {
  766.             puts "Unexpected syntax: $line"
  767.             puts " Must be a begin-line of a section (eg. method, type declaration)"
  768.             puts " Possibly a wrong end-line (eg. end-line inside comment)"
  769.             set ret 0
  770.         }
  771.  
  772.         # end parser
  773.         if { ! $ret } {
  774.             # something went wrong
  775.                m4_error $E_STOP [[$this currentEntry] getName]
  776.             return
  777.             # return 0
  778.         }
  779.     }
  780.  
  781.     if { [$this obsolete] == 1 } {
  782.         # read file pointed by setting pointer back and reread it
  783.         seek $fileDesc 0
  784.         set cont [TextSection new]
  785.         while { ![eof $fileDesc] } {
  786.             $cont append "[gets $fileDesc]\n"
  787.         }
  788.         # write old file
  789.         set oldFileHandler [PBFileHandler new]
  790.         $oldFileHandler writeSectionToFile $cont [[[$this currentEntry] globalDefinition] ooplClass]\
  791.                 "old.[[$this currentEntry] getFileType]"
  792.     }
  793.     # everthing went succesfully (maybe some obsolete code)
  794.     return
  795.     # return 1
  796. }
  797.  
  798. method PBRegenerator::checkEntryFiles {this entry fileDesc} {
  799.     # if any .old file is present stop regenerating!
  800.     set files [fstorage::dir]
  801.     if {[regexp {\.old} $files]} {
  802.         m4_error $E_HASOLD
  803.         return 0
  804.     } else {
  805.         return 1
  806.     }
  807. }
  808.  
  809. method PBRegenerator::processFile {this entry fileDesc} {
  810.     # !! Implement this function !!
  811. }
  812.  
  813. method PBRegenerator::processForward {this entry fileDesc} {
  814.     # read and skip all lines until a "end forward"
  815.     # return false if eof
  816.     set done 0
  817.     while { ![eof $fileDesc] && !$done } {
  818.         set line [gets $fileDesc]
  819.  
  820.         if { [regexp {^end forward[ \t]*$} $line ] } {
  821.             set done 1
  822.             break
  823.         }
  824.     }
  825.     set ret $done
  826.     return $ret
  827. }
  828.  
  829. method PBRegenerator::processType {this class fileDesc} {
  830.     # read and parse all lines until a "end type"
  831.     set done 0
  832.     while { ![eof $fileDesc] && !$done } {
  833.         set line [gets $fileDesc]
  834.         set type ""
  835.         set typename ""
  836.         set eventname ""
  837.         set value ""
  838.         if { [regexp {^end type[ \t]*$} $line ] } {
  839.             set done 1
  840.             break
  841.         }
  842.         if { [regexp {^ *([^ ]*) ([^ =]*) *=[ ]*([^\{ ].*)$}\
  843.                   $line total type typename value] } {
  844.  
  845.            } elseif { [regexp {^ *([^ ]*) ([^ =]*) *=[ ]*(\{[^\{\}]*\})}\
  846.                         $line total type typename value] } {
  847.  
  848.         } elseif { [regexp {^ *([^ ]*) ([^ =]*) *=[ ]*(\{[^\}]*)$}\
  849.                         $line total type typename value] } {
  850.             # append value until closing brace is read
  851.             set end 0
  852.             while {![eof $fileDesc] && !$end } {
  853.                 set line [gets $fileDesc]
  854.                 if { [regexp {[^\}]*\}} $line] } {
  855.                     set end 1
  856.                     set value "$value\n$line"
  857.                 } else {
  858.                     set value "$value\n$line"
  859.                 }
  860.             }
  861.         } elseif { [regexp {^ *event ([^ ]*) ([^ ]*)}\
  862.                         $line total eventname eventid] } {
  863.         
  864.         } elseif { [regexp {^ *event type ([^ ]*) ([^ ]*) \( \)} \
  865.                         $line total type eventname] } {
  866.             
  867.         } elseif { [regexp {^ *event ([^ ]*) (\([^\)]*\))} \
  868.                         $line total eventname] } {
  869.         
  870.         } elseif { [regexp {([^ ]*) ([^ ]*)} $line total type name] } {
  871.             if { $type == $name } {
  872.                 # equals so probable a contained element
  873.             } else {
  874.                 # a declared something
  875.                 set typename $name
  876.             }
  877.         } else {
  878.         }
  879.         # if there is a typename add a builtin property to the class
  880.         if { [$class isA "PBVisual"] } {
  881.             if { $typename != "" && \
  882.                     [string tolower $typename] != "menuname" && \
  883.                     [string tolower $typename] != "windowtype"} {
  884.                 $class setBuiltinProperty $typename \
  885.                         [PBBuiltinProperty new $typename $type $value \
  886.                         -where ${PBBuiltinProperty::InTypeDef} ]
  887.             }
  888.         }
  889.     }
  890.     # generate syntax error because done not set
  891.     if { !$done } {
  892.         m4_error $E_ENDEXPECT "type" [$class name]
  893.     }
  894.     set ret $done
  895.     return $ret
  896. }
  897.  
  898. method PBRegenerator::skipType {this fileDesc} {
  899.     # read and skip all lines until a "end type"
  900.     # return false if eof
  901.     set done 0
  902.     while { ![eof $fileDesc] && !$done } {
  903.         set line [gets $fileDesc]
  904.         if { [regexp {^end type[ \t]*} $line ] } {
  905.             set done 1
  906.             break
  907.         }
  908.     }
  909.     set ret $done
  910.     return $ret
  911. }
  912.  
  913. method PBRegenerator::processVariables {this vars fileDesc} {
  914.     # read and skip all lines (= variables) except those after 
  915.     # the non-modelled user defined attributes (and Declare ... ;) )
  916.     set done 0
  917.     # process variable section
  918.     # return false if eof
  919.     while { ![eof $fileDesc] && !$done } {
  920.         set line [gets $fileDesc]
  921.         if { [regexp {^end variables[ \t]*$} $line ] } {
  922.             # exit all
  923.             set done 1
  924.         } elseif { [regexp {^ *DECLARE.*} [string toupper $line] ] } {
  925.             # declared SQL query/function, non-object-team support so user defined:
  926.             $vars append $line
  927.             $vars append "\n"
  928.             # read all lines until a line ends with ";"
  929.             set declare 0
  930.             while { ![eof $fileDesc] && !$declare } {
  931.                 set line [gets $fileDesc]
  932.                 if { [regexp {[^;]*;.*} $line ] } {
  933.                     $vars append $line
  934.                     $vars append "\n"
  935.                     set declare 1
  936.  
  937.                 } elseif { [regexp {^end variables[ \t]*} $line ] } {
  938.                     # exit all
  939.                     set done 1
  940.                     set declare 1
  941.                     m4_error $E_DECLARESYNTAX [[$this currentClass] name]
  942.                 } else {
  943.                     $vars append $line
  944.                     $vars append "\n"
  945.                 }
  946.             }
  947.         } elseif { [regexp "${PBCookie::nonModeledAttributeSection}" $line ] } {
  948.             # read all lines until next section (or "end variables" or EOF)
  949.             set next 0
  950.             set emptyLine 0
  951.             set emptyLineStr ""
  952.             while { ![eof $fileDesc] && !$next } {
  953.                 set line [gets $fileDesc]
  954.                 if { [regexp {^end variables[ \t]*$} $line ] } {
  955.                     # exit all
  956.                     set done 1
  957.                     set next 1
  958.                 } elseif { [regexp {^[ \t]*$} $line] } {
  959.                     # some special empty line handling
  960.                     # when empty line remember this and
  961.                     # only store this line when NOT end of section
  962.                     if { $emptyLine == 1 } {
  963.                         # when already an empty line in buffer store this one
  964.                         $vars append $emptyLineStr
  965.                         $vars append "\n"
  966.                     } else {
  967.                         set emptyLine 1
  968.                         set emptyLineStr $line
  969.                     }
  970.                 } elseif { ![regexp "${PBCookie::dataAttributeSection}" $line] && \
  971.                             ![regexp "${PBCookie::associationAttributeSection}" $line] && \
  972.                             ![regexp "${PBCookie::controlClassMapSection}" $line] } {
  973.                     if { $emptyLine == 1 } {
  974.                         # there is an empty line waiting to be stored first
  975.                         $vars append $emptyLineStr
  976.                         $vars append "\n"
  977.                         set emptyLine 0
  978.                         set emptyLineStr ""
  979.                     }
  980.                     $vars append $line
  981.                     $vars append "\n"
  982.                 } else {
  983.                     # exit this section
  984.                     set next 1
  985.                 }
  986.             }
  987.         } else {
  988.         }
  989.         #end while
  990.     }
  991.     set ret $done
  992.  
  993.     return $ret
  994. }
  995.  
  996. method PBRegenerator::skipVariables {this fileDesc} {
  997.     # read and skip all lines until a "end type"
  998.     # return false if eof
  999.     set done 0
  1000.     while { ![eof $fileDesc] && !$done } {
  1001.         set line [gets $fileDesc]
  1002.  
  1003.         if { [regexp {^end variables[ \t]*$} $line ] } {
  1004.             set done 1
  1005.             break
  1006.         }
  1007.     }
  1008.  
  1009.     set ret $done
  1010.     return $ret
  1011. }
  1012.  
  1013. method PBRegenerator::processPrototypes {this class fileDesc} {
  1014.     # read and skip all lines until a "end prototypes"
  1015.     # return false if eof
  1016.     set done 0
  1017.     while { ![eof $fileDesc] && !$done } {
  1018.         set line [gets $fileDesc]
  1019.  
  1020.         if { [regexp {^end prototypes[ \t]*$} $line ] } {
  1021.             set done 1
  1022.             break
  1023.         }
  1024.     }
  1025.  
  1026.     # generate syntax error because done not set
  1027.     if { !$done } {
  1028.         m4_error $E_ENDEXPECT "prototypes" [$class name]
  1029.     }
  1030.  
  1031.     set ret $done
  1032.     return $ret
  1033. }
  1034.  
  1035. method PBRegenerator::processStructure {this class fileDesc} {
  1036.     # read and skip all lines until a "end type"
  1037.     # return false if eof
  1038.     set done 0
  1039.     while { ![eof $fileDesc] && !$done } {
  1040.         set line [gets $fileDesc]
  1041.  
  1042.         if { [regexp {^end type[ \t]*$} $line ] } {
  1043.             set done 1
  1044.             break
  1045.         }
  1046.     }
  1047.  
  1048.     # generate syntax error because done not set
  1049.     if { !$done } {
  1050.         m4_error $E_ENDEXPECTMETHOD "type" "(structure)" [$class name]
  1051.     }
  1052.  
  1053.     set ret $done
  1054.     return $ret
  1055. }
  1056.  
  1057. method PBRegenerator::processEntryStructure {this class fileDesc} {
  1058.     # read and skip all lines until a "end type"
  1059.     # return false if eof
  1060.     set done 0
  1061.     while { ![eof $fileDesc] && !$done } {
  1062.         set line [gets $fileDesc]
  1063.  
  1064.         if { [regexp {^end type[ \t]*$} $line ] } {
  1065.             set done 1
  1066.             break
  1067.         }
  1068.     }
  1069.     
  1070.     # generate syntax error because done not set
  1071.     if { !$done } {
  1072.         m4_error $E_ENDEXPECTMETHOD "type" "(structure)" [$class name]
  1073.     }
  1074.  
  1075.     set ret $done
  1076.     return $ret
  1077. }
  1078.  
  1079. method PBRegenerator::processEvent {this body fileDesc line} {
  1080.     # read and add all lines until a "end type"
  1081.     # return false if eof
  1082.     # if there is a start and end marker only get code between those
  1083.     #    eg constructor and destructor events
  1084.     #    deletes added code before any startmarker!
  1085.     #    stops adding after end marker!
  1086.     set done 0
  1087.     set skip 0
  1088.     set bodyTmp [TextSection new]
  1089.  
  1090.     while { ![eof $fileDesc] && !$done } {
  1091.         if { [regexp {^end event[ \t]*$} $line ] } {
  1092.             set done 1
  1093.             break
  1094.         } elseif { [regexp "^ *${PBCookie::endUserSection}" $line ] } {
  1095.             set skip 1
  1096.             # nothing
  1097.         } elseif { [regexp "^ *${PBCookie::startUserSection}" $line ] } {
  1098.             set skip 0
  1099.             set bodyTmp [TextSection new]
  1100.             # nothing
  1101.         } else {
  1102.             # add line to body
  1103.             if {$skip == 0} {
  1104.                 $bodyTmp append $line
  1105.                 $bodyTmp append "\n"
  1106.             }
  1107.         }
  1108.         # read next line
  1109.         set line [gets $fileDesc]
  1110.     }
  1111.  
  1112.     $body appendSect $bodyTmp
  1113.     set ret $done
  1114.     return $ret
  1115. }
  1116.  
  1117. method PBRegenerator::skipEvent {this fileDesc} {
  1118.     # read and skip all lines until a "end event"
  1119.     # return false if eof
  1120.     set done 0
  1121.     while { ![eof $fileDesc] && !$done } {
  1122.         set line [gets $fileDesc]
  1123.  
  1124.         if { [regexp {^end event[ \t]*$} $line ] } {
  1125.             set done 1
  1126.             break
  1127.         }
  1128.     }
  1129.  
  1130.     set ret $done
  1131.     return $ret
  1132. }
  1133.  
  1134. method PBRegenerator::processFunction {this body fileDesc line} {
  1135.     # read and add all lines until a "end type"
  1136.     # return false if eof
  1137.     set done 0
  1138.  
  1139.     # set to false:
  1140.     set skip 0
  1141.     set bodyTmp [TextSection new]
  1142.  
  1143.     while { ![eof $fileDesc] &&  !$done } {
  1144.         if { [regexp {^end function[ \t]*$} $line ] } {
  1145.             set done 1
  1146.             break
  1147.         } elseif { [regexp "^ *${PBCookie::associationAccessorMethod}" $line] } {
  1148.             set skip 1
  1149.  
  1150.             # nothing
  1151.         } elseif { [regexp {^ *// User defined method.*} $line] } {
  1152.             set skip 0
  1153.  
  1154.             # nothing
  1155.         } else {
  1156.             # add line to body
  1157.             $bodyTmp append $line
  1158.             $bodyTmp append "\n"
  1159.         }
  1160.         # read next line
  1161.         set line [gets $fileDesc]
  1162.     }
  1163.  
  1164.     if { $skip == 0} {
  1165.         $body appendSect $bodyTmp
  1166.     }
  1167.  
  1168.     set ret $done
  1169.     return $ret
  1170. }
  1171.  
  1172. method PBRegenerator::skipFunction {this fileDesc} {
  1173.     # read and skip all lines until a "end function"
  1174.     # return false if eof
  1175.     set done 0
  1176.     
  1177.     while { ![eof $fileDesc] && !$done } {
  1178.         set line [gets $fileDesc]
  1179.         
  1180.         if { [regexp {^end function[ \t]*$} $line ] } {
  1181.             set done 1
  1182.             break
  1183.         }
  1184.     }
  1185.     
  1186.     set ret $done
  1187.     return $ret
  1188. }
  1189.  
  1190. method PBRegenerator::processSubroutine {this body fileDesc line} {
  1191.     # read and add all lines until a "end type"
  1192.     # return false if eof
  1193.     set done 0
  1194.     
  1195.     # set to false:
  1196.     set skip 0
  1197.     set bodyTmp [TextSection new]
  1198.     
  1199.     while { ![eof $fileDesc] &&  !$done } {
  1200.         if { [regexp {^end subroutine[ \t]*$} $line ] } {
  1201.             set done 1
  1202.             break
  1203.         } elseif { [regexp "^ *${PBCookie::associationAccessorMethod}" $line ] } {    
  1204.             set skip 1
  1205.             # nothing
  1206.         } elseif { [regexp {^ *// User defined method.*} $line ] } {
  1207.             set skip 0
  1208.             # nothing                
  1209.         } else {
  1210.             # add line to body
  1211.             $bodyTmp append $line
  1212.             $bodyTmp append "\n"
  1213.         }
  1214.         # read next line
  1215.         set line [gets $fileDesc]
  1216.     }
  1217.     
  1218.     if { $skip == 0} {
  1219.         $body appendSect $bodyTmp
  1220.     }
  1221.     
  1222.     set ret $done
  1223.     return $ret
  1224. }
  1225.  
  1226. method PBRegenerator::skipSubroutine {this fileDesc} {
  1227.     # read and skip all lines until a "end function"
  1228.     # return false if eof
  1229.     set done 0
  1230.     while { ![eof $fileDesc] && !$done } {
  1231.         set line [gets $fileDesc]
  1232.  
  1233.         if { [regexp {^end subroutine[ \t]*} $line ] } {
  1234.             set done 1
  1235.             break
  1236.         }
  1237.     }
  1238.  
  1239.     set ret $done
  1240.     return $ret
  1241. }
  1242.  
  1243. method PBRegenerator::processBinaryData {this body fileDesc} {
  1244.     # read and add all lines until a "End of PowerBuilder Binary Data Section : No Source Expected After This Point"
  1245.     # return false if eof
  1246.     set done 0
  1247.     while { ![eof $fileDesc] &&  !$done } {
  1248.         if { [regexp {^ *End of PowerBuilder Binary Data Section : No Source Expected After This Point.*} $line ] } {
  1249.             set done 1
  1250.             break       
  1251.         } else {
  1252.             # add line to body
  1253.             $body append $line
  1254.             $body append "\n"
  1255.         }
  1256.         # read next line
  1257.         set line [gets $fileDesc]
  1258.     }
  1259.  
  1260.     set ret $done
  1261.     return $ret
  1262. }
  1263.  
  1264. method PBRegenerator::skipBinaryData {this fileDesc} {
  1265.     # read and skip all lines until a "End of PowerBuilder Binary Data Section : No Source Expected After This Point"
  1266.     # return false if eof
  1267.     set done 0
  1268.     while { ![eof $fileDesc] && !$done } {
  1269.         set line [gets $fileDesc]
  1270.  
  1271.         if { [regexp "^ *${PBCookie::endBinaryDataSection}.*" $line ] } {
  1272.             set done 1
  1273.             break
  1274.         }
  1275.     }
  1276.  
  1277.     set ret $done
  1278.     return $ret
  1279. }
  1280.  
  1281. method PBRegenerator::processOn {this body fileDesc line} {
  1282.     # read and add all lines until a "end type"
  1283.     # return false if eof
  1284.     set done 0
  1285.     while { ![eof $fileDesc] &&  !$done } {
  1286.         if { [regexp {^end on[ \t]*$} $line ] } {
  1287.             set done 1
  1288.             break
  1289.         } elseif { [regexp "^ *${PBCookie::associationAccessorMethod}.*" $line ] } {
  1290.             # nothing
  1291.         } elseif { [regexp {// User defined method.*} $line ] } {
  1292.             # nothing
  1293.         } else {
  1294.             # add line to body
  1295.             $body append $line
  1296.             $body append "\n"
  1297.         }
  1298.         # read next line
  1299.         set line [gets $fileDesc]
  1300.     }
  1301.  
  1302.     set ret $done
  1303.     return $ret
  1304. }
  1305.  
  1306. method PBRegenerator::skipOn {this fileDesc} {
  1307.     # read and skip all lines until a "end on"
  1308.     # return false if eof
  1309.     set done 0
  1310.     while { ![eof $fileDesc] && !$done } {
  1311.         set line [gets $fileDesc]
  1312.  
  1313.         if { [regexp {^end on[ \t]*$} $line ] } {
  1314.             set done 1
  1315.             break
  1316.         }
  1317.     }
  1318.  
  1319.     set ret $done
  1320.     return $ret
  1321. }
  1322.  
  1323.  
  1324. method PBRegenerator::processOnCreate {this class fileDesc line} {
  1325.     # scan on-body for property initializations
  1326.     set done 0
  1327.  
  1328.     if { [$class onCreateResidue] != "" } {
  1329.         set body [$class onCreateResidue] 
  1330.     } else {
  1331.         set body [TextSection new]
  1332.         $class onCreateResidue $body
  1333.     }
  1334.  
  1335.     while { ![eof $fileDesc] && !$done } {
  1336.         set line [gets $fileDesc]
  1337.         set type ""
  1338.         set name ""
  1339.         set value ""
  1340.  
  1341.  
  1342.         if { [regexp {^end on[ \t]*$} $line ] } {
  1343.             set done 1
  1344.             break
  1345.         }
  1346.  
  1347.         if { [regexp {^ *this\.([^ =]*) *= *create .*} $line total ] } {
  1348.  
  1349.         } elseif { [regexp {^ *this\.([^ =]*) *= *([^\{ ].*)$} $line total name value] } {
  1350.  
  1351.             
  1352.         } elseif { [regexp {^ *this\.([^ =]*) *= *(\{[^\}]*\})} $line total name value] } {
  1353.  
  1354.  
  1355.         } elseif { [regexp {^ *if.*} $line] } {
  1356.  
  1357.  
  1358.         } elseif { [regexp {^ *this\.([^ =]*) *= *(\{[^\}]*\})$} $line total name value] } {
  1359.  
  1360.  
  1361.         } elseif { [regexp {^ *this\.([^ =]*) *= *(\{[^\}]*)$} $line total name value] } {
  1362.             # append value until closing brace is read
  1363.             set end 0
  1364.             while {![eof $fileDesc] && !$end } {
  1365.                 set line [gets $fileDesc]
  1366.                 if { [regexp {[^\}]*\}.*} $line] } {
  1367.                     set end 1
  1368.                     set value "$value\n$line"
  1369.                 } else {
  1370.                     set value "$value\n$line"
  1371.                 }
  1372.             }
  1373.         } elseif { [regexp {^ *call ([^:]*)::create *} $line total callname] } {
  1374.             if { $callname != [$class superClassName] } {
  1375.                 # add unknown line to crappy section.
  1376.                 $body append $line
  1377.                 $body append "\n"
  1378.             } 
  1379.         } else {
  1380.             # add unknown lines to crappy section.
  1381.             $body append $line
  1382.             $body append "\n"
  1383.         }
  1384.  
  1385.         # these exceptions may not be added:
  1386.         set tmpname [string tolower $name]
  1387.         if {($tmpname == "item\[\]") || \
  1388.                 ($tmpname == "control\[\]") } {
  1389.             set name ""
  1390.         }
  1391.         # if there is a name add a builtin property to the class
  1392.         if { $name != "" } {
  1393.             $class setBuiltinProperty $name \
  1394.                 [PBBuiltinProperty new $name $type $value \
  1395.                      -where ${PBBuiltinProperty::InOnCreate} ]
  1396.  
  1397.         }
  1398.     }
  1399.     set ret $done
  1400.     return $ret
  1401. }
  1402.  
  1403. method PBRegenerator::processOnDestroy {this class fileDesc line} {
  1404.     # skip on body and return false when eof
  1405.     set done 0
  1406.  
  1407.     if { [$class onDestroyResidue] != "" } {
  1408.         set body [$class onDestroyResidue] 
  1409.     } else {
  1410.         set body [TextSection new]
  1411.         $class onDestroyResidue $body
  1412.     }
  1413.  
  1414.     while { ![eof $fileDesc] && !$done } {
  1415.         set line [gets $fileDesc]
  1416.  
  1417.         if { [regexp {^end on[ \t]*$} $line ] } {
  1418.             set done 1
  1419.             break
  1420.         } else {
  1421.             # add unknown lines to crappy section.
  1422.             $body append $line
  1423.             $body append "\n"
  1424.         }
  1425.     }
  1426.     set ret $done
  1427.     return $ret
  1428. }
  1429.  
  1430. method PBRegenerator::processParameter {this line} {
  1431.     # create list of argument/parameter types from string given by line
  1432.  
  1433.     set lst [List new]
  1434.  
  1435.     # strip parentheses
  1436.     if { [regexp {^ *\(([^)]*)\) *$} $line total params] } {
  1437.         set params [string tolower $params]
  1438.  
  1439.     } else {
  1440.         set params [string tolower $line]
  1441.  
  1442.  
  1443.     }
  1444.     while { [regexp {^ *(reference |ref |readonly |value |)([^ ]*) ([^ ,]*) *,(.*)} $params total passBy type name params_] } {
  1445.  
  1446.  
  1447.             set params $params_
  1448.  
  1449.             $lst append $type
  1450.     }
  1451.         
  1452.     if { [regexp {^ *(reference |ref |readonly |value |)([^ ]*) ([^ ]*) *} $params total passBy type name] } {
  1453.  
  1454.             $lst append $type
  1455.  
  1456.     }
  1457.  
  1458.     set i 0
  1459.     $lst foreach arg {
  1460.         incr i 1
  1461.     }
  1462.  
  1463.  
  1464.     return $lst
  1465. }
  1466.  
  1467. # Do not delete this line -- regeneration end marker
  1468.  
  1469.