home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / stinterfac.tcl < prev    next >
Text File  |  1997-08-13  |  7KB  |  236 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)stinterfac.tcl    /main/titanic/4
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)stinterfac.tcl    /main/titanic/4   13 Aug 1997 Copyright 1997 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12. require platform.tcl
  13. # End user added include file section
  14.  
  15.  
  16. # This class is the interface to a Smalltalk
  17. # system. It is responsible for: code generation settings,
  18. # creating dialogs, generating special files and
  19. # starting Smalltalk.
  20.  
  21. Class STInterface : {Object} {
  22.     constructor
  23.     method destructor
  24.     method generateImport
  25.     method generateExport
  26.     method getSelectedFiles
  27.     method readFiles
  28.     method addSuperClasses
  29.     method createSettingsDialog
  30.  
  31.     # All files of type smalltalk in the current system.
  32.     #
  33.     attribute allFiles
  34.  
  35.     # The selected files in the current system.
  36.     #
  37.     attribute selectedFiles
  38.  
  39.     # The selected classes in the current system.
  40.     #
  41.     attribute selectedClasses
  42.  
  43.     # Mapping from class name to file name.
  44.     #
  45.     attribute classToFile
  46.  
  47.     # Mapping from classes to super classes.
  48.     #
  49.     attribute classToSuper
  50.  
  51.     # The filehandler instance used by this interface.
  52.     #
  53.     attribute fileHandler
  54.  
  55.     # Generator used by this interface.
  56.     #
  57.     attribute generator
  58. }
  59.  
  60. constructor STInterface {class this name} {
  61.     set this [Object::constructor $class $this $name]
  62.     # Start constructor user section
  63.     $this classToSuper [Dictionary new]
  64.     $this classToFile [Dictionary new]
  65.     $this selectedClasses [List new]
  66.     $this selectedFiles [List new]
  67.     $this allFiles [List new]
  68.     $this createSettingsDialog
  69.     # End constructor user section
  70.     return $this
  71. }
  72.  
  73. method STInterface::destructor {this} {
  74.     # Start destructor user section
  75.     # End destructor user section
  76. }
  77.  
  78.  
  79. # Generates the import script: determines the files to be included,
  80. # reads the class hierarchy from all files and calls the generator. <selection>
  81. # indicates whether selected or all was chosen in
  82. # the Smalltalk menu.
  83. #
  84. method STInterface::generateImport {this selection} {
  85.     $this getSelectedFiles
  86.     if { $selection == "all" } {
  87.     [$this selectedFiles] contents [[$this allFiles] contents]
  88.     }
  89.     if [[$this selectedFiles] empty] {
  90.     wmtkerror "No class files selected"
  91.     return
  92.     }
  93.     $this readFiles
  94.     $this addSuperClasses
  95.  
  96.     [$this generator] generateImport [$this selectedClasses] [$this classToSuper] [$this classToFile]
  97. }
  98.  
  99.  
  100. # Generates the export script for the classes in <selection>: determines the files to be
  101. # included, reads all files to find the corresponding classes
  102. # and calls the generator.
  103. # <selection> indicates whether all or selected was chosen in the 
  104. # Smalltalk menu.
  105. #
  106. method STInterface::generateExport {this selection} {
  107.     $this getSelectedFiles
  108.     if { $selection == "all" } {
  109.     [$this selectedFiles] contents [[$this allFiles] contents]
  110.     }
  111.     if [[$this selectedFiles] empty] {
  112.     wmtkerror "No class files selected"
  113.     return
  114.     }
  115.     $this readFiles
  116.  
  117.     [$this generator] generateExport [$this selectedClasses] [$this classToFile]
  118. }
  119.  
  120.  
  121. # Gets the selected files from the browser
  122. # and sets selectedFiles.
  123. #
  124. method STInterface::getSelectedFiles {this} {
  125.     set stType [[$this fileHandler] stType]
  126.     if { ![[$this selectedFiles] empty] } {
  127.     [$this selectedFiles] remove 0 end
  128.     }
  129.  
  130.     foreach obj [$wmttoolObj selectedObjSet] {
  131.     if [$obj isA SystemFileReference] {
  132.         set fileV [$obj getInfo "File Version"]
  133.         if {"$fileV" != ""} {
  134.         set type [[$fileV file] type]
  135.         if { $type == $stType } {
  136.             [$this selectedFiles] append "[[$fileV file] name].$type"
  137.         }
  138.         }
  139.     } elseif [$obj isA FileVersion] {
  140.         set type [[$obj file] type]
  141.         if { $type == $stType } {
  142.                 [$this selectedFiles] append "[[$obj file] name].$type"
  143.         }
  144.     }
  145.     }
  146.  
  147.     [$this allFiles] contents [fstorage::dir [[$this fileHandler] stType]]
  148.  
  149.     # import and export scripts are discarded
  150.     [[$this fileHandler] getSpecialFiles] foreach fileName { 
  151.     [$this allFiles] removeValue $fileName
  152.     [$this selectedFiles] removeValue $fileName
  153.     }
  154. }
  155.  
  156.  
  157. # Reads all files and fills classToSuper,
  158. # classToFile and selectedClasses.
  159. #
  160. method STInterface::readFiles {this} {
  161.     if { ![[$this selectedClasses] empty] } {
  162.     [$this selectedClasses] remove 0 end
  163.     }
  164.  
  165.     [$this allFiles] foreach fileName {
  166.     set fd [fstorage::open $fileName r]
  167.     while {[gets $fd line] >= 0} {
  168.         set wordList [split $line " "]
  169.         # check if second word is subclass keyword 
  170.         if [regexp ubclass: [lindex $wordList 1]] {
  171.         regsub -all # [lindex $wordList 2] "" className
  172.         set superName [lindex $wordList 0]
  173.         [$this classToFile] set $className $fileName
  174.         [$this classToSuper] set $className $superName
  175.         if { [[$this selectedFiles] search $fileName] != -1 } {
  176.             [$this selectedClasses] append $className
  177.         }
  178.         break
  179.         }
  180.     }
  181.     fstorage::close $fd
  182.     }
  183. }
  184.  
  185.  
  186. # Adds the superclasses of the classes
  187. # selectedClasses to selectedClasses.
  188. #
  189. method STInterface::addSuperClasses {this} {
  190.     [$this selectedClasses] foreach className {
  191.     if [[$this classToSuper] exists $className] {
  192.         set super [[$this classToSuper] set $className]
  193.         if [[$this classToFile] exists $super] {
  194.         if { [[$this selectedClasses] search $super] == - 1} {
  195.             [$this selectedClasses] append $super
  196.         }
  197.         }
  198.     }
  199.     }
  200. }
  201.  
  202.  
  203. # Creates the dialog for the code generation
  204. # settings.
  205. #
  206. method STInterface::createSettingsDialog {this} {
  207.     require stgentor.tcl
  208.     set st_default_category [STGGlobal::getDefaultCategory]
  209.     set st_default_category "${st_default_category} Name"
  210.     set st_generate_print [STGGlobal::getGeneratePrint]
  211.     TemplateDialog new .main.stconfig \
  212.     -title "Smalltalk code generation" \
  213.     -okPressed { .main.stconfig popDown }
  214.     .main.stconfig delCancelButton
  215.     DlgColumn new .main.stconfig.col
  216.     NamedGroup new .main.stconfig.col.grp \
  217.         -label "Code generation settings"
  218.     DlgColumn new .main.stconfig.col.grp.col
  219.     DlgRow new .main.stconfig.col.grp.col.print
  220.     DlgRow new .main.stconfig.col.grp.col.category 
  221.     if {$st_generate_print} {
  222.         Label new .main.stconfig.col.grp.col.print.label \
  223.             -text "- Generate print methods for classes"
  224.     } else {
  225.         Label new .main.stconfig.col.grp.col.print.label \
  226.             -text "- Not generating print methods for classes"
  227.     }
  228.     Label new .main.stconfig.col.grp.col.category.label \
  229.         -text "- \'$st_default_category\' is used as default category name"
  230.     Label new .main.stconfig.col.info \
  231.         -text "Settings can be changed using the System Properties"
  232. }
  233.  
  234. # Do not delete this line -- regeneration end marker
  235.  
  236.