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