PC World 1997 November/PCWorld_1997-11_cd.bin/software/programy/komix/DATA.Z/stgenerato.tcl

Text File | 1997-05-05 | 8KB | 254 lines

#---------------------------------------------------------------------------
#
#      (c)     Cayenne Software Inc.    1997
#
#      File:           @(#)stgenerato.tcl    /main/hindenburg/4
#      Author:         <generated>
#      Description:
#---------------------------------------------------------------------------
# SccsId = @(#)stgenerato.tcl    /main/hindenburg/4   5 May 1997 Copyright 1997 Cayenne Software Inc.

# Start user added include file section

require stgglobal.tcl

set globals [STGGlobal new]

# End user added include file section

require "generator.tcl"

# This class is the entry point of the Smalltalk code generator.

Class STGenerator : {Generator} {
    constructor
    method destructor
    method generate
    method generateSpecialFiles
    method sortClasses
    method generateImport
    method generateExport

    # The file handler for this generator.
    #
    attribute fileHandler
}

constructor STGenerator {class this} {
    set this [Generator::constructor $class $this]
    # Start constructor user section
    $this fileHandler [STFileHandler new]
    # End constructor user section
    return $this
}

method STGenerator::destructor {this} {
    # Start destructor user section
    # End destructor user section
    $this Generator::destructor
}


# Generates for <classList>, see description in class Generator.
#
method STGenerator::generate {this classList} {
    # set header variables
    set cc [ClientContext::global]
    set proj [$cc currentProject]
    set configV [$cc currentConfig]
    set phaseV [$cc currentPhase]
    set systemV [$cc currentSystem]
    if {![$proj isNil] } {
        set projName [$proj name]
    }
    if {![$configV isNil] } {
        set configName [[$configV config] name]
    }
    if {![$phaseV isNil] } {
        set phaseName [[$phaseV phase] name]
    }
    if {![$systemV isNil] } {
        set systemName [[$systemV system] name]
    }

    # initialize file handler, type and result variables
    set type [[$this fileHandler] stType]
    set typeToClassDictionary [Dictionary new]
    set classToSection [Dictionary new]
    $typeToClassDictionary set [[$this fileHandler] stType] $classToSection
    set regenerator [STRegenerator new]

    # start generation
    $classList foreach class {
        set fileObject [STFile new]
        set implementation [$fileObject getImplementation [$class getSTName]]
        $class generate $implementation

        # do regeneration
        $regenerator regenerate $class $fileObject

        set text [TextSection new]

        # do header
        set fileName [[$this fileHandler] getFileName $class $type]
        expand_file $text [m4_path_name etc $type.hdr] proj $proj \
            configV [$configV versionNumber] \
            phaseV [$phaseV versionNumber] \
            filename $fileName \
            systemV [$systemV versionNumber]\
            projName $projName \
            configName $configName \
            phaseName $phaseName \
            systemName $systemName

        $fileObject generate $text

        $classToSection set $class $text
    }
    return $typeToClassDictionary
}


# Generates special files: the import and/or
# the export file.
# Makes a mapping from class to fileName
# and from class to super class and
# generates the file specified in <fileList>.
#
method STGenerator::generateSpecialFiles {this ooplModel fileList} {
    set classList [List new]
    set classToSuper [Dictionary new]
    set classToFile [Dictionary new]

    foreach class [$ooplModel ooplClassSet] {
        if [$class isExternal] {
            continue
        }
        set className [$class getSTName]
        $classList append $className

        # get superclass
        set gnodeSet [$class genNodeSet]

        if { [llength $gnodeSet] == 0 } {
            $classToSuper set $className "Object"
        } else {
            $classToSuper set $className [[[lindex $gnodeSet 0] superClass]\
                                              getSTName]
        }

        $classToFile set $className [[$this fileHandler] getFileName $class\
                                         [[$this fileHandler] stType]]
    }

    $fileList foreach specialFile {
        if { [[$this fileHandler] getImportFileName] == $specialFile } {
            puts "Generating import script for all classes"
            $this generateImport $classList $classToSuper $classToFile
        }
        if { [[$this fileHandler] getExportFileName] == $specialFile } {
            puts "Generating export script for all classes"
            $this generateExport $classList $classToFile
        }
    }
}


# Sorts the classes in <classList> in
# prefix order. <classToSuper> maps classes to
# their super classes and <classToFile> maps
# classes to file names, these are used during
# the sort process.
#
method STGenerator::sortClasses {this classList classToSuper classToFile} {
    upvar $classList selectedClasses
    # make class to subs and root classes
    set rootClasses [List new]
    set classToSubs [Dictionary new]
    $classToSuper foreach className superName {
        if { ![$classToSubs exists $superName] } {
            $classToSubs set $superName [List new]
        }
        if { [[$classToSubs set $superName] search $className] == -1 } {
            # if super does not have a file it must be external
            # and thus a root class
            if { ![$classToFile exists $superName] } {
                # now get the subclass of the external root class
                if { [$rootClasses search $className] == -1 } {
                    $rootClasses append $className
                }
            }
            [$classToSubs set $superName] append $className
        }
    }

    # little hack: when an class <Object> was present,
    # an empty import-file was created. This is corrected
    # by setting rootClasses:
    if { [$rootClasses empty] } {
        $rootClasses append "Object"
    }

    # walk the inheritance tree till the leaves and
    # append every selected class visited
    # yielding the classes in prefix order in newSelectedClasses
    set newSelectedClasses [List new]
    while { ![$rootClasses empty] } {
        set currentClass [$rootClasses index 0]
        if { [$selectedClasses search $currentClass] != -1 } {
            $newSelectedClasses append $currentClass
        }
        if [$classToSubs exists $currentClass] {
            [$classToSubs set $currentClass] foreach subClass {
                if { [$rootClasses search $subClass] == -1 } {
                    $rootClasses append $subClass
                }
            }
        }
        $rootClasses removeValue $currentClass
    }
    set selectedClasses $newSelectedClasses
}


# Generates the import file: sorts the
# classes in <classList> , creates a section with
# Smalltalk expression to file in these
# classes and writes the import file.
#
method STGenerator::generateImport {this classList classToSuper classToFile} {
    set importSection [TextSection new]
    set clientContext [ClientContext::global]
    set pathName [[$clientContext currentSystem] path]

    $this sortClasses classList $classToSuper $classToFile
    $classList foreach className {
        set fileName [path_name concat $pathName [$classToFile set $className]]
        $importSection append "(Filename named: \'$fileName\') fileIn!\n"
    }
    set fileName [[$this fileHandler] getImportFileName]
    [$this fileHandler] writeSectionToNamedFile $importSection $fileName
}


# Generates the export file: creates a section
# with Smalltalk expressions to file out
# the classes in <classList> and writes
# the export file.
#
method STGenerator::generateExport {this classList classToFile} {
    set exportSection [TextSection new]
    set clientContext [ClientContext::global]
    set pathName [[$clientContext currentSystem] path]

    $classList foreach className {
        set fileName [path_name concat $pathName [$classToFile set $className]]
        $exportSection append "(Filename named: \'$fileName\') fileOutChangesFor: $className!\n"
    }
    set fileName [[$this fileHandler] getExportFileName]
    [$this fileHandler] writeSectionToNamedFile $exportSection $fileName
}

# Do not delete this line -- regeneration end marker