PC World 1998 October/PCWorld_1998-10_cd.bin/software/prehled/komix/DATA.Z/corbagen.tcl

Text File | 1997-12-01 | 5.9 KB | 219 lines

#---------------------------------------------------------------------------
#
# Copyright (c) 1997 by Cayenne Software, Inc.
#
# This software is furnished under a license and may be used only in
# accordance with the terms of such license and with the inclusion of
# the above copyright notice. This software or any other copies thereof
# may not be provided or otherwise made available to any other person.
# No title to and ownership of the software is hereby transferred.
#
# The information in this software is subject to change without notice
# and should not be construed as a commitment by Cayenne Software, Inc.
#
#---------------------------------------------------------------------------
#
#       File            : corbagen.tcl
#       Author          :
#       Original date   : November 1997
#       Description     : Classes for generating CORBA IDL code
#
#---------------------------------------------------------------------------

#---------------------------------------------------------------------------
#      File:           @(#)idfilehand.tcl    /main/titanic/1
#---------------------------------------------------------------------------

# Start user added include file section
# End user added include file section

require "filehandle.tcl"

Class IDFileHandler : {FileHandler} {
    constructor
    method destructor
    method getSpecialFiles
    method getFileTypes
    attribute fileType
}

constructor IDFileHandler {class this} {
    set this [FileHandler::constructor $class $this]
    # Start constructor user section
    $this fileType "idl"
    # End constructor user section
    return $this
}

method IDFileHandler::destructor {this} {
    # Start destructor user section
    # End destructor user section
    $this FileHandler::destructor
}

method IDFileHandler::getSpecialFiles {this} {
    return [List new]
}

method IDFileHandler::getFileTypes {this} {
    set list [List new]
    $list append [$this fileType]
    return $list
}

# Do not delete this line -- regeneration end marker

#---------------------------------------------------------------------------
#      File:           @(#)idgenerato.tcl    /main/titanic/5
#---------------------------------------------------------------------------

# Start user added include file section
# End user added include file section

require "generator.tcl"

Class IDGenerator : {Generator} {
    constructor
    method destructor
    method generate
    method check
    method writeFile
    attribute fileHandler
}

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

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

method IDGenerator::generate {this classList} {
    set sectMgr [IDGDataMgr::getMgr]
    set systemName [getCurrentSystemName]

    set sect [$sectMgr getSect fileHeader]
    expandHeaderIntoSection $systemName.idl corba $sect
    $sect append "#ifndef ${systemName}_IDL_\n#define ${systemName}_IDL_\n\n"

    [$sectMgr getSect fileTrailer] append "\n#endif /* ${systemName}_IDL_ */\n"

    if {$systemName != ""} {
    [$sectMgr getSect header] append "module $systemName \{\n"
    [$sectMgr getSect trailer] append "\};\n"
    } else {
    [$sectMgr sectNameSet] foreach sect {
        [$sectMgr getSect $sect] indent -
    }
    }

    set classess {}
    $classList foreach class {
    if {[$class getPropertyValue external_source] != ""} {
        set includes [split [$class getPropertyValue external_source] ","]
        foreach incl $includes {
        $sectMgr addInclude "<[string trim $incl]>" 0
        }
        continue
    }
    if {[$class isExternal]} {
        set system [$class definingSystem]
        if {$system == ""} {
        m4_error $E_NOT_DEFINED [$class getName]
        continue
        }
        $sectMgr addInclude $system
        continue
    }
    if {[$class getName] == ""} {
        m4_error $E_NO_NAME Class
        continue
    }
    lappend classess [$class getName]

    $class generate
    }

    regexp ".(.)." [location h g] dummy sep
    set sect [$sectMgr getSect includes]
    [$sectMgr includeSet] foreach incl {
    set hasGuard [expr {![regexp "^<" $incl]}]
    if {$hasGuard} {
        $sect append "#ifndef [lindex [split $incl $sep] 1]_IDL_\n"
    }
    $sect append "#include $incl\n"
    if {$hasGuard} {
        $sect append "#endif\n"
    }
    }
    $sect append "\n"

    set sect [$sectMgr getSect forwardDecl]
    [$sectMgr forwardSet] foreach forw {
    $sect append "interface $forw;\n"
    }
    $sect append "\n"

    if {$classess != {}} {
    $this writeFile $classess ${systemName}.idl
    }

    $sectMgr delMgr
    return [Dictionary new]
}

method IDGenerator::check {this classList} {
    # we check by setting 'checkOnly' on and then generate as usual
    #
    [IDGDataMgr::getMgr] checkOnly 1
    $classList foreach class {
    $class generate
    }
}

method IDGenerator::writeFile {this classList name} {
    puts stdout ""

    if {[M4CheckManager::getErrorCount] != 0} {
    puts stderr "Not saving $name because of previous errors."
    return 0
    }

    set cmpSect [TextSection new]
    set idlMgr [IDGDataMgr::getMgr]
    [$idlMgr sectNameSet] foreach sect {
    $cmpSect appendSect [$idlMgr getSect $sect]
    }

    if {[section_equals_file $cmpSect $name]} {
    puts stderr "$name has not changed: file not written"
    return 0
    }

    puts stdout "Generating $name"
    if {[catch {set fd [fstorage::open $name w]} reason]} {
    puts stderr $reason
    m4_error $E_FILE_OPEN_WRITE $name
    return 0
    }

    if {[catch {fstorage::set_imp_from $name $classList} reason]} {
    puts stderr $reason
    }

    $cmpSect write $fd
    fstorage::close $fd

    return 1
}

# Do not delete this line -- regeneration end marker