home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / vbgentor.tcl < prev    next >
Text File  |  1997-05-02  |  33KB  |  888 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            : vbgentor.tcl
  17. #       Author          : 
  18. #       Original date   : May 1997
  19. #       Description     : Classes for code generation
  20. #
  21. #---------------------------------------------------------------------------
  22.  
  23. #---------------------------------------------------------------------------
  24. #      File:           @(#)vbfilehand.tcl    /main/hindenburg/7
  25. #---------------------------------------------------------------------------
  26.  
  27. # Start user added include file section
  28. # End user added include file section
  29.  
  30. require "filehandle.tcl"
  31.  
  32. Class VBFileHandler : {FileHandler} {
  33.     constructor
  34.     method destructor
  35.     method getFileName
  36.     method getSpecialFiles
  37.     method getFileTypes
  38.     method getProjectFileName
  39.     attribute VBPType
  40.     attribute FRMType
  41.     attribute BASType
  42.     attribute CLSType
  43.     attribute OLDType
  44. }
  45.  
  46. constructor VBFileHandler {class this} {
  47.     set this [FileHandler::constructor $class $this]
  48.     $this VBPType "vbp"
  49.     $this FRMType "frm"
  50.     $this BASType "bas"
  51.     $this CLSType "cls"
  52.     $this OLDType "old"
  53.     # Start constructor user section
  54.     # End constructor user section
  55.     return $this
  56. }
  57.  
  58. method VBFileHandler::destructor {this} {
  59.     # Start destructor user section
  60.     # End destructor user section
  61.     $this FileHandler::destructor
  62. }
  63.  
  64. method VBFileHandler::getFileName {this class fileType} {
  65.     if {$fileType == [$this BASType]} {
  66.           return "[$class getName]Extras.$fileType"
  67.     } else {
  68.           return "[$class getName].$fileType"
  69.     }
  70. }
  71.  
  72. method VBFileHandler::getSpecialFiles {this} {
  73.         set list [List new]
  74.         $list append [$this getProjectFileName]
  75.         return $list
  76. }
  77.  
  78. method VBFileHandler::getFileTypes {this} {
  79.         set list [List new]
  80.         $list append [$this VBPType]
  81.         $list append [$this FRMType]
  82.         $list append [$this BASType]
  83.         $list append [$this CLSType]
  84.         $list append [$this OLDType]
  85.         return $list
  86. }
  87.  
  88. method VBFileHandler::getProjectFileName {this} {
  89.     return "[getCurrentSystemName].[$this VBPType]"
  90. }
  91.  
  92. # Do not delete this line -- regeneration end marker
  93.  
  94. #---------------------------------------------------------------------------
  95. #      File:           @(#)vbgenadapt.tcl    /main/hindenburg/4
  96. #---------------------------------------------------------------------------
  97.  
  98. # Start user added include file section
  99. # End user added include file section
  100.  
  101.  
  102. Class VBGenAdapter : {GCObject} {
  103.     constructor
  104.     method destructor
  105.     method generate
  106. }
  107.  
  108. constructor VBGenAdapter {class this} {
  109.     set this [GCObject::constructor $class $this]
  110.     # Start constructor user section
  111.     # End constructor user section
  112.     return $this
  113. }
  114.  
  115. method VBGenAdapter::destructor {this} {
  116.     # Start destructor user section
  117.     # End destructor user section
  118. }
  119.  
  120. method VBGenAdapter::generate {this} {
  121.     # Source stolen from STGenAdapter::generate
  122.     set fileHandler [VBFileHandler new]
  123.     $fileHandler sourceTclFiles
  124.     set ooplModel [$oomodel ooplModel]
  125.     set selectedClasses [List new]
  126.  
  127.     foreach class [getSelectedOoplClasses $ooplModel] {
  128.         if [$class isExternal] {
  129.             continue
  130.         }
  131.  
  132.         if {[$class getName] == ""} {
  133.             m4_error $E_NONAMECLASS
  134.             continue
  135.         }
  136.  
  137.         set externalSource [List new]
  138.         $externalSource contents [string trim [$class getPropertyValue class_source]]
  139.         if { ![$externalSource empty] } {
  140.             $externalSource foreach fileName {
  141.                 $fileHandler importExternal $class [$fileHandler c
  142. ppType] $fileName
  143.             }
  144.             continue
  145.         }
  146.  
  147.         $selectedClasses append $class
  148.     }
  149.  
  150.     $fileHandler checkUniqueFiles $selectedClasses
  151.  
  152.     set  vbgenerator [VBGenerator new]
  153.     $selectedClasses foreach class {
  154.         set l [List new]
  155.         $l append $class
  156.         set generatedSections [$vbgenerator generate $l]
  157.  
  158.         $generatedSections foreach class classToSection {
  159.             $classToSection foreach type section {
  160.                 #TODO: fileTypes
  161.                 $fileHandler writeSectionToFile $section $class $type
  162.             }
  163.             set classToSection ""
  164.         }
  165.         set generatedSections ""
  166.     }
  167.  
  168.     # special files
  169.     if $import_new {
  170.         set specialFileList [$fileHandler getSpecialFiles]
  171.     } else {
  172.         set specialFileList [List new]
  173.         set selectedFiles [get_tgt_objs]
  174.         [$fileHandler getSpecialFiles] foreach specialFile {
  175.             if { [lsearch $selectedFiles $specialFile] != -1 } {
  176.                 $specialFileList append $specialFile
  177.             }
  178.         }
  179.     }
  180.     if { ![$specialFileList empty] } {
  181.         if {[M4CheckManager::getErrorCount] > 0} {
  182.             m4_error $E_NOSPECFILES
  183.         } else {
  184.             $vbgenerator generateSpecialFiles $specialFileList
  185.         }
  186.     }
  187. }
  188.  
  189. # Do not delete this line -- regeneration end marker
  190.  
  191. #---------------------------------------------------------------------------
  192. #      File:           @(#)vbgenerato.tcl    /main/hindenburg/16
  193. #---------------------------------------------------------------------------
  194.  
  195. # Start user added include file section
  196. # End user added include file section
  197.  
  198. require "generator.tcl"
  199.  
  200. Class VBGenerator : {Generator} {
  201.     constructor
  202.     method destructor
  203.     method generate
  204.     method generateSpecialFiles
  205.     attribute fileHandler
  206. }
  207.  
  208. constructor VBGenerator {class this} {
  209.     set this [Generator::constructor $class $this]
  210.     # Start constructor user section
  211.         $this fileHandler [VBFileHandler new]
  212.     # End constructor user section
  213.     return $this
  214. }
  215.  
  216. method VBGenerator::destructor {this} {
  217.     # Start destructor user section
  218.     # End destructor user section
  219.     $this Generator::destructor
  220. }
  221.  
  222. method VBGenerator::generate {this classList} {
  223.         set typeToClassDict [Dictionary new]
  224.         set project [VBProject new]
  225.  
  226.         $classList foreach cl {
  227.                 if {[$cl baseType] != "NodeControl" && [$cl baseType] != "LeafControl"} {
  228.                       $cl generate $project
  229.                       set tempDict [Dictionary new]
  230.                       $typeToClassDict set $cl $tempDict     
  231.                 }
  232.         }
  233.  
  234.         [$project form] foreach formkey formval {
  235.              $formval configur
  236.         }
  237.         if {[$project mdiform] != ""} {
  238.              [$project mdiform] configur
  239.         }
  240.      
  241.         set regenerator [VBRegenerator new [$this fileHandler]]
  242.         $regenerator regenerate $classList $project
  243.  
  244.         $project generate $typeToClassDict
  245.         return $typeToClassDict
  246. }
  247.  
  248. method VBGenerator::generateSpecialFiles {this fileList} {
  249.      $fileList foreach specialFile {
  250.         set fileName [[$this fileHandler] getProjectFileName]
  251.         set project [TextSection new]
  252.  
  253.         set startup "(None)"
  254.         set hasstartup 1
  255.         foreach class [[$oomodel ooplModel] ooplClassSet] {
  256.             if {[$class isExternal]} {
  257.                 continue
  258.             }
  259.             if {[$class hasMain]} {
  260.                        switch [$class baseClass] {
  261.                              "Form"    {
  262.                                            $project append "Form="
  263.                                            $project append [[$this fileHandler] getFileName $class "frm"]
  264.                                            $project append "\n"
  265.                                            if {[$class getPropertyValue "is_startup"] == 1} {
  266.                                               if {$startup == "(None)"} {
  267.                                                  set startup [$class getName]
  268.                                                  set hasstartup 1
  269.                                               } else {
  270.                                                  m4_error $E_DOUBLESTARTUP [$class getName] $startup
  271.                                                  set hasstartup 0
  272.                                               }
  273.                                            }
  274.                              }
  275.                              "Class"   {
  276.                                            $project append "Class="
  277.                                            $project append [$class getName]
  278.                                            $project append "; "             
  279.                                            $project append [[$this fileHandler] getFileName $class "cls"]
  280.                                            $project append "\n"
  281.                                            if {[$class getPropertyValue "is_startup"] == 1} {
  282.                                               m4_warning $W_CANTBESTARTUP [$class getName]
  283.                                            }
  284.                              }
  285.                              "MDIForm" {
  286.                                            $project append "Form="
  287.                                            $project append [[$this fileHandler] getFileName $class "frm"]
  288.                                            $project append "\n"
  289.                                            if {[$class getPropertyValue "is_startup"] == 1} {
  290.                                               if {$startup == "(None)"} {
  291.                                                  set startup [$class getName]
  292.                                                  set hasstartup 1
  293.                                               } else {
  294.                                                  m4_error $E_DOUBLESTARTUP [$class getName] $startup
  295.                                                  set hasstartup 0
  296.                                               }
  297.                                            }
  298.                              }
  299.                              default   {
  300.                                            if {[$class getPropertyValue "is_startup"] == 1} {
  301.                                               m4_warning $W_CANTBESTARTUP [$class getName]
  302.                                            }
  303.                                            continue
  304.                              }
  305.                        }
  306.             }
  307.  
  308.             if {[$class hasExtras]} {
  309.                $project append "Module="
  310.                $project append [$class getName]
  311.                if {[$class baseClass] != "Enum"} {
  312.                     $project append "Extras"    
  313.                }
  314.                $project append "; "             
  315.                $project append [[$this fileHandler] getFileName $class "bas"]
  316.                $project append "\n"
  317.             }
  318.         }
  319.  
  320.         set cc [ClientContext::global]
  321.  
  322.         $project append "Class=ClassSet; ..\\src\\ClassSet.cls\n"
  323.         $project append [$cc getCustomFileContents "auto32ld" "vbp" etc]
  324.         $project append "Name=\"[getCurrentSystemName]\"\n"
  325.         
  326.         if {$startup == "(None)"} {
  327.            m4_warning $W_NOSTARTUP $fileName
  328.         };
  329.  
  330.         if {$hasstartup} {
  331.            $project append "Startup=\"$startup\"\n"
  332.            m4_message $M_CREATINGSPEC $fileName
  333.            [$this fileHandler] writeSectionToNamedFile $project $fileName
  334.         } else {
  335.            m4_message $M_ERSTARTUP $fileName
  336.         }
  337.      }
  338. }
  339.  
  340. # Do not delete this line -- regeneration end marker
  341.  
  342. #---------------------------------------------------------------------------
  343. #      File:           @(#)vbregenera.tcl    /main/hindenburg/16
  344. #---------------------------------------------------------------------------
  345.  
  346. # Start user added include file section
  347. # End user added include file section
  348.  
  349. require "regenerato.tcl"
  350.  
  351. Class VBRegenerator : {Regenerator} {
  352.     constructor
  353.     method destructor
  354.     method regenerate
  355.     method checkClassFiles
  356.     method processGUIClassDef
  357.     method processGUIForm
  358.     method processGUIControl
  359.     method processGUIMenu
  360.     method processGUIFormDef
  361.     method processCodeDef
  362.     method grabMethodBody
  363.     method putMethodUserCode
  364.     attribute fileHandler
  365. }
  366.  
  367. constructor VBRegenerator {class this fileHandler} {
  368.     set this [Regenerator::constructor $class $this]
  369.     $this fileHandler $fileHandler
  370.     # Start constructor user section
  371.     # End constructor user section
  372.     return $this
  373. }
  374.  
  375. method VBRegenerator::destructor {this} {
  376.     # Start destructor user section
  377.     # End destructor user section
  378.     $this Regenerator::destructor
  379. }
  380.  
  381. method VBRegenerator::regenerate {this classList project} {
  382.         $classList foreach cl {
  383.             set obscls 0
  384.             set obsfrm 0
  385.             set obsbas 0
  386.             set rmvcls 0
  387.             set rmvfrm 0
  388.             set rmvbas 0
  389.  
  390.             if {[$cl baseType] != "NodeControl" && [$cl baseType] != "LeafControl" && [$cl baseClass] != "Enum"} {
  391.                 if {[$this checkClassFiles $cl]} {
  392.                      set fileDesc [[$this fileHandler] openFile $cl "cls"]
  393.                      if {$fileDesc != ""} {
  394.                          if {[$cl baseType] == "Class"} {
  395.                               if {[$this processGUIClassDef $cl $project $fileDesc]} {
  396.                                   set obscls 1
  397.                               }
  398.                               if {[$this processCodeDef $cl $project $fileDesc]} {
  399.                                   set obscls 1
  400.                               }
  401.                          } else {
  402.                              m4_warning $W_OBSOL [[$this fileHandler] getFileName $cl "cls"]
  403.                              set obscls 1
  404.                              set rmvcls 1
  405.                          }
  406.                          [$this fileHandler] closeFile $fileDesc
  407.                      }
  408.  
  409.                      set fileDesc [[$this fileHandler] openFile $cl "frm"]
  410.                      if {$fileDesc != ""} {
  411.                          if {[$cl baseType] != "Class"} {
  412.                               if {[$this processGUIFormDef $cl $project $fileDesc]} {
  413.                                   set obsfrm 1
  414.                               }
  415.                               if {[$this processCodeDef $cl $project $fileDesc]} {
  416.                                   set obsfrm 1
  417.                               }
  418.                          } else {
  419.                              m4_warning $W_OBSOL [[$this fileHandler] getFileName $cl "frm"]
  420.                              set obsfrm 1
  421.                              set rmvfrm 1
  422.                          }
  423.                          [$this fileHandler] closeFile $fileDesc
  424.                      }
  425.  
  426.                      set fileDesc [[$this fileHandler] openFile $cl "bas"]
  427.                      if {$fileDesc != ""} {
  428.                          if {[$cl hasExtras]} { 
  429.                              if {[$this processCodeDef $cl $project $fileDesc]} {
  430.                                  set obsbas 1
  431.                              }
  432.                          } else {
  433.                              m4_warning $W_OBSOL [[$this fileHandler] getFileName $cl "bas"]
  434.                              set obsbas 1
  435.                              set rmvbas 1
  436.                          }
  437.                          [$this fileHandler] closeFile $fileDesc
  438.                      }
  439.                 }
  440.             }
  441.  
  442.             if {$obscls} {
  443.                   set fileDesc [[$this fileHandler] openFile $cl "cls"]
  444.                   set cont     [TextSection new]
  445.                   while {![eof $fileDesc]} {
  446.                        $cont append "[gets $fileDesc]\n"
  447.                   }
  448.                   [$this fileHandler] closeFile $fileDesc
  449.                   [$this fileHandler] writeSectionToFile $cont $cl "old"
  450.                   if {$rmvcls} {
  451.                       if {[M4CheckManager::getErrorCount] > 0} {
  452.                           puts "Not removing [[$this fileHandler] getFileName $cl "cls"] because of previous errors"
  453.                       } else {
  454.                             fstorage::remove [[$this fileHandler] getFileName $cl "cls"]
  455.               }
  456.                   }
  457.             }
  458.  
  459.             if {$obsfrm} {
  460.                   set fileDesc [[$this fileHandler] openFile $cl "frm"]
  461.                   set cont     [TextSection new]
  462.                   while {![eof $fileDesc]} {
  463.                        $cont append "[gets $fileDesc]\n"
  464.                   }
  465.                   [$this fileHandler] closeFile $fileDesc
  466.                   [$this fileHandler] writeSectionToFile $cont $cl "old"
  467.                   if {$rmvfrm} {
  468.                       fstorage::remove [[$this fileHandler] getFileName $cl "frm"]
  469.                   }
  470.             }
  471.  
  472.             if {$obsbas} {
  473.                   set fileDesc [[$this fileHandler] openFile $cl "bas"]
  474.                   set cont     [TextSection new]
  475.                   while {![eof $fileDesc]} {
  476.                        $cont append "[gets $fileDesc]\n"
  477.                   }
  478.                   [$this fileHandler] closeFile $fileDesc
  479.                   puts stdout "Creating [$cl getName]Extras.old" 
  480.                   [$this fileHandler] writeSectionToNamedFile $cont "[$cl getName]Extras.old"
  481.                   if {$rmvbas} {
  482.                       fstorage::remove [[$this fileHandler] getFileName $cl "bas"]
  483.                   }
  484.             }
  485.         }
  486. }
  487.  
  488. method VBRegenerator::checkClassFiles {this class} {
  489.          set files [fstorage::dir]
  490.          if {[regexp "[$class getName].old" $files]} {
  491.                m4_error $E_HASOLD [$class getName]
  492.                return 0
  493.          } else {
  494.                return 1
  495.          }
  496. }
  497.  
  498. method VBRegenerator::processGUIClassDef {this class project fileDesc} {
  499.         set done  0
  500.         set start 0
  501.         set cont [TextSection new]
  502.         set cl [$project getClassmodule [$class getName]]
  503.  
  504.         set line [gets $fileDesc]
  505.         set line [gets $fileDesc]
  506.         set line [gets $fileDesc]
  507.         set line [gets $fileDesc]
  508.  
  509.         while {![eof $fileDesc] && !$done} {
  510.             set line [gets $fileDesc]
  511.             
  512.             if {[regexp ${VBCookie::regenMarker} $line]} {
  513.                             set done 1
  514.             } else {
  515.                if {![regexp {Attribute[     ]*VB_Name=} $line]} {
  516.                    $cont append "$line\n"
  517.                } else {
  518.                    $cont append "Attribute VB_Name = \"[$cl name]\"\n"
  519.                }
  520.             }
  521.         }
  522.         $cl attribs $cont 
  523.  
  524.         return 0
  525. }
  526.  
  527. method VBRegenerator::processGUIForm {this form fileDesc} {
  528.         set done  0
  529.         set obs   0
  530.         set specs [TextSection new]
  531.  
  532.         while {![eof $fileDesc] && !$done} {
  533.              set line [gets $fileDesc]
  534.             if {[regexp {End[     ]*} $line]} {
  535.                             set done 1
  536.             } else { 
  537.                 if {[regexp {Begin[     ]*([^\.]*)\.([^ ^    ]*)[     ]*([^ ^    ]*)} $line total guilib guitype name]} {
  538.                         if {$guitype == "Menu"} {
  539.                            set contr ""
  540.                            [$form menuSet] foreach menu {
  541.                                 if {[$menu name] == $name} {
  542.                                     set contr $menu 
  543.                                     $form removeMenu $menu
  544.                                     $form addSortedmenu $menu
  545.                                     break
  546.                                 }
  547.                            }
  548.                            if {$contr == ""} {
  549.                                m4_warning $W_OBSOLCONTROL $name
  550.                                set obs 1
  551.                            }
  552.                            if {[$this processGUIMenu $contr $fileDesc]} {
  553.                                 set obs 1
  554.                            }
  555.                         } else {
  556.                            set contr ""
  557.                            [$form controlSet] foreach cont {
  558.                                 if {[$cont name] == $name && [$cont specs] == ""} {
  559.                                     set contr $cont 
  560.                                     break
  561.                                 }
  562.                            }
  563.                            if {$contr == ""} {
  564.                                m4_warning $W_OBSOLCONTROL $name
  565.                                set obs 1
  566.                            }
  567.                            if {[$this processGUIControl $contr $fileDesc]} {
  568.                                 set obs 1
  569.                            }
  570.                        }
  571.                 } else {
  572.                       $specs append "$line\n"         
  573.                 }
  574.             }
  575.         }         
  576.         if {![regexp {End[     ]*} $line]} {
  577.               if {[eof $fileDesc]} {
  578.                   m4_error $E_SYNTAX "End" "end of file"
  579.               } else {
  580.                   m4_error $E_SYNTAX "End" $line
  581.               }
  582.         } 
  583.         
  584.         $form specs $specs
  585.         return $obs
  586. }
  587.  
  588. method VBRegenerator::processGUIControl {this control fileDesc} {
  589.         set obs   0
  590.  
  591.         if {$control == ""} {
  592.            set done  0
  593.            while {![eof $fileDesc] && !$done} {
  594.                 set line [gets $fileDesc]
  595.                if {[regexp {End[     ]*} $line]} {
  596.                                set done 1
  597.                } else { 
  598.                    if {[regexp {Begin[     ]*([^\.]*)\.([^ ^    ]*)[     ]*([^ ^    ]*)} $line total guilib guitype name]} {
  599.                         set contr ""
  600.                         m4_warning $W_OBSOLCONTROL $name
  601.                         set obs 1
  602.                         $this processGUIControl $contr $fileDesc
  603.                    }
  604.                }
  605.            }         
  606.         } else {
  607.            set specs [TextSection new]
  608.            set done  0
  609.            while {![eof $fileDesc] && !$done} {
  610.                 set line [gets $fileDesc]
  611.                if {[regexp {End[     ]*} $line]} {
  612.                                set done 1
  613.                } else { 
  614.                    if {[regexp {Begin[     ]*([^\.]*)\.([^ ^    ]*)[     ]*([^ ^    ]*)} $line total guilib guitype name]} {
  615.                         set contr ""
  616.                         [$control subcontrolSet] foreach cont {
  617.                              if {[$cont name] == $name && [$cont specs] == ""} {
  618.                                  set contr $cont 
  619.                                  break
  620.                              }
  621.                         }
  622.                         if {$contr == ""} {
  623.                             m4_warning $W_OBSOLCONTROL $name
  624.                             set obs 1
  625.                         }
  626.                         if {[$this processGUIControl $contr $fileDesc]} {
  627.                              set obs 1
  628.                         }
  629.                    } else {
  630.                        if {[regexp {[     ]*Index[     ]*=[     ]*([^ ^    ])*} $line total indx]} {
  631.                             if {[$control hasIndex]} {
  632.                                   $specs append "$line\n"         
  633.                                   $control index $indx         
  634.                                   $control indexInSpecs 1         
  635.                             }
  636.                        } else {
  637.                             $specs append "$line\n"         
  638.                        }
  639.                    }
  640.                }
  641.            }         
  642.            $control specs $specs
  643.         }
  644.  
  645.         if {![regexp {End[     ]*} $line]} {
  646.              if {[eof $fileDesc]} {
  647.                   m4_error $E_SYNTAX "End" "end of file"
  648.              } else {
  649.                   m4_error $E_SYNTAX "End" $line
  650.              }
  651.         } 
  652.  
  653.         return $obs
  654. }
  655.  
  656. method VBRegenerator::processGUIMenu {this menu fileDesc} {
  657.         set obs   0
  658.  
  659.         if {$menu == ""} {
  660.            set done  0
  661.            while {![eof $fileDesc] && !$done} {
  662.                 set line [gets $fileDesc]
  663.                if {[regexp {End[     ]*} $line]} {
  664.                                set done 1
  665.                } else { 
  666.                    if {[regexp {Begin[     ]*([^\.]*)\.([^ ^    ]*)[     ]*([^ ^    ]*)} $line total guilib guitype name]} {
  667.                         set contr ""
  668.                         m4_warning $W_OBSOLCONTROL $name
  669.                         set obs 1
  670.                         $this processGUIMenu $contr $fileDesc
  671.                    }
  672.                }
  673.            }         
  674.         } else {
  675.            set specs [TextSection new]
  676.            set done  0
  677.            while {![eof $fileDesc] && !$done} {
  678.                 set line [gets $fileDesc]
  679.                if {[regexp {End[     ]*} $line]} {
  680.                                set done 1
  681.                } else { 
  682.                    if {[regexp {Begin[     ]*([^\.]*)\.([^ ^    ]*)[     ]*([^ ^    ]*)} $line total guilib guitype name]} {
  683.                         set contr ""
  684.                         [$menu submenuSet] foreach mnu {
  685.                              if {[$mnu name] == $name} {
  686.                                  set contr $mnu 
  687.                                  $menu removeSubmenu $mnu
  688.                                  $menu addSortedsubmenu $mnu
  689.                                  break
  690.                              }
  691.                         }
  692.                         if {$contr == ""} {
  693.                             m4_warning $W_OBSOLCONTROL $name
  694.                             set obs 1
  695.                         }
  696.                         if {[$this processGUIMenu $contr $fileDesc]} {
  697.                             set obs 1
  698.                         }
  699.                    } else {
  700.                        if {[regexp {[     ]*Index[     ]*=[     ]*([^ ^    ])*} $line total indx]} {
  701.                             if {[$menu hasIndex]} {
  702.                                   $specs append "$line\n"         
  703.                                   $menu index $indx         
  704.                                   $menu indexInSpecs 1         
  705.                             }
  706.                        } else {
  707.                             $specs append "$line\n"         
  708.                        }
  709.                    }
  710.                }
  711.            }         
  712.         
  713.            $menu specs $specs
  714.         }
  715.  
  716.         if {![regexp {End[     ]*} $line]} {
  717.               if {[eof $fileDesc]} {
  718.                   m4_error $E_SYNTAX "End" "end of file"
  719.               } else {
  720.                   m4_error $E_SYNTAX "End" $line
  721.               }
  722.         } 
  723.         return $obs
  724. }
  725.  
  726. method VBRegenerator::processGUIFormDef {this class project fileDesc} {
  727.         set obs   0
  728.         set start 0
  729.         set cont [TextSection new]
  730.         set cl [$project getForm [$class getName]]
  731.         if {$cl == ""} {
  732.              if {[[$project mdiform] name] == [$class getName]} {
  733.                   set cl [$project mdiform]
  734.              }
  735.         }
  736.  
  737.         $cl objects [TextSection new]
  738.         set done  0
  739.         while {![eof $fileDesc] && !$done} {
  740.             set line [gets $fileDesc]
  741.             if {[regexp {Begin[     ]*VB\.(Form|MDIForm)} $line]} {
  742.                             set done 1
  743.             } else { 
  744.                if {[regexp {^[     ]*Object[     ]*=[     ]*} $line]} {
  745.                   [$cl objects] append "$line\n"
  746.                } 
  747.             }
  748.         }
  749.  
  750.         if {[regexp {Begin[     ]*VB\.(Form|MDIForm)} $line]} {
  751.                 $this processGUIForm $cl $fileDesc
  752.                 set done  0
  753.                 while {![eof $fileDesc] && !$done} {
  754.                     set line [gets $fileDesc]
  755.                 
  756.                     if {[regexp ${VBCookie::regenMarker} $line]} {
  757.                                     set done 1
  758.                     } else {
  759.                           if {[regexp {Attribute[     ]*VB_([^ ^    ]*)[     ]*=} $line]} {
  760.                                if {![regexp {Attribute[     ]*VB_Name[     ]*=} $line]} {
  761.                                    $cont append "$line\n"
  762.                                } else {
  763.                                    $cont append "Attribute VB_Name = \"[$cl name]\"\n"
  764.                                }
  765.                           } else {
  766.                                set done 1
  767.                           }
  768.                     }
  769.                 }
  770.                 if {[regexp ${VBCookie::regenMarker} $line]} {
  771.                 $cl attribs $cont 
  772.                 } else {
  773.                          m4_error $E_SYNTAX ${VBCookie::regenMarker} $line
  774.                 }
  775.         } else {
  776.                m4_error $E_SYNTAX "Beginning of Form" "end of file"
  777.         }
  778.  
  779.         return $obs 
  780. }
  781.  
  782. method VBRegenerator::processCodeDef {this class project fileDesc} {
  783.         set done 0
  784.         set obs 0
  785.         set exp_method {^[     ]*(Public|Private)[     ]*(Static)?[     ]*(Sub|Function)[     ]*([^(]*)\(([^)]*)\)[     ]*(As[     ]*([^ ]*))?}
  786.  
  787.         while {![eof $fileDesc] && !$done} {
  788.             set line [gets $fileDesc]
  789.             if {[regexp ${VBCookie::regenMarker} $line]} {
  790.                             set done 1
  791.             } else {
  792.                        if {[regexp $exp_method $line total access dummy1 procType totalname params dummy2 returnvalue]} {
  793.                             if {![regexp {([^_]*)_([^ ^    ]*)} $totalname total refname name]} {
  794.                                   set refname ""
  795.                                   set name $totalname
  796.                             } 
  797.                             if {[$this putMethodUserCode $class $project [$this grabMethodBody $fileDesc] $refname $name]} {
  798.                                   set obs 1
  799.                             }     
  800.                        } 
  801.            }
  802.         }
  803.         if {![regexp ${VBCookie::regenMarker} $line]} {
  804.                m4_error $E_SYNTAX ${VBCookie::regenMarker} "end of file"
  805.         }
  806.         return $obs
  807. }
  808.  
  809. method VBRegenerator::grabMethodBody {this fileDesc} {
  810.         set usercode [TextSection new]
  811.         set done 0
  812.         
  813.         while {![eof $fileDesc] && !$done} {
  814.             set line [gets $fileDesc]
  815.  
  816.             if {[regexp ${VBCookie::endUserSection} $line] || [regexp {^[     ]*(End)[     ]*(Sub|Function)} $line]} {
  817.                             set done 1
  818.             } else {
  819.                             if {[regexp ${VBCookie::startUserSection} $line]} {
  820.                                  set usercode [TextSection new]
  821.                             } else {
  822.                                  $usercode append "$line\n"
  823.                             } 
  824.             } 
  825.         }
  826.         return $usercode
  827. }
  828.  
  829. method VBRegenerator::putMethodUserCode {this class project userCode refname name} {
  830.            set cl [$project getClassmodule [$class getName]]
  831.            if {$cl == ""} {
  832.                set cl [$project getForm [$class getName]]
  833.                if {$cl == ""} {
  834.                     if {[[$project mdiform] name] == [$class getName]} {
  835.                          set cl [$project mdiform]
  836.                     }
  837.                }
  838.            }
  839.  
  840.            set proc ""
  841.            if {$proc == "" && $refname == ""} {
  842.                    set proc [$cl getUserproc $name]
  843.            }
  844.            if {$proc == "" && $refname == [$cl name]} {
  845.                    set proc [$cl getGlobproc $name]
  846.            }
  847.  
  848.            if {$proc == "" && [$class baseType] == "Window" && $refname == [$cl type]} {
  849.                    set proc [$cl getEvent $name]
  850.            }
  851.  
  852.            if {$proc == "" && [$class baseType] == "Window"} {
  853.                   [$cl containerSet] foreach container {
  854.                         if {[$container name] == $refname} {
  855.                               set proc [$container getEvent $name]
  856.                               if {$proc != ""} {
  857.                                    break
  858.                               }
  859.                         }
  860.                   }
  861.            }
  862.  
  863.            if {$proc == "" && $refname == [$cl type] && $name == [[$cl terminate] name]} {
  864.                   set proc [$cl terminate]
  865.            }
  866.  
  867.        if {[$cl constructor] != ""} {
  868.                if {$proc == "" && $refname == [$cl name] && $name == [[$cl constructor] name]} {
  869.                       set proc [$cl constructor]
  870.                }
  871.        }
  872.  
  873.            if {$proc != ""} {
  874.                   $proc usercode $userCode
  875.            } else {
  876.                 if {$refname != ""} {
  877.                      m4_warning $W_OBSOLPROC "${refname}_$name"
  878.                 } else {
  879.                      m4_warning $W_OBSOLPROC "$name"
  880.                 }
  881.                 return 1
  882.            }
  883.         return 0
  884. }
  885.  
  886. # Do not delete this line -- regeneration end marker
  887.  
  888.