home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World 1998 October
/
PCWorld_1998-10_cd.bin
/
software
/
prehled
/
komix
/
DATA.Z
/
export.tcl
< prev
next >
Wrap
Text File
|
1997-10-10
|
6KB
|
244 lines
#include <iostream.h>
#---------------------------------------------------------------------------
#
# (c) Westmount Technology 1994
#
# File: @(#)export.tcl /main/titanic/2
# Author: <generated>
# Description:
#---------------------------------------------------------------------------
# SccsId = @(#)export.tcl /main/titanic/2 10 Oct 1997 Copyright 1994 Westmount Technology
# Start user added include file section
global Export::options
set Export::options {
orientation width height file format aframe
project config phase system
}
# End user added include file section
Class Export : {Object} {
constructor
method destructor
}
constructor Export {class this name} {
set this [Object::constructor $class $this $name]
# Start constructor user section
# End constructor user section
return $this
}
method Export::destructor {this} {
# Start destructor user section
# End destructor user section
}
# Export a diagram to a file in a certain format.
#
proc Export::exportDiagram {args} {
Export::processOptions options i $args
Export::setContext options
if { [expr [llength $args] - $i] == 0 } {
error "requires diagram name and type"
}
if { [expr [llength $args] - $i] == 1 } {
error "requires diagram type"
}
if { [expr [llength $args] - $i] > 2 } {
error "too many arguments"
}
set uiFileName [lindex $args $i]
regsub : $uiFileName / fileName
incr i
set fileType [lindex $args $i]
set context [ClientContext::global]
set configV [$context currentConfig]
set systemV [$context currentSystem]
set diag [$systemV findFileVersion $fileName $fileType]
if [$diag isNil] {
error "diagram '$uiFileName.$fileType' not found"
}
puts "Exporting diagram '$uiFileName.$fileType' ..."
# Configure Exporter.
#
set printer [Printer new]
if [info exists options(width)] {
$printer pageWidth $options(width)
}
if [info exists options(height)] {
$printer pageHeight $options(height)
}
if {![info exists options(file)]} {
error "exportDiagram needs -file option"
}
set file $options(file)
if {![info exists options(format)]} {
error "exportDiagram needs -format option"
}
set exportType [string toupper $options(format)]
if [info exists options(aframe)] {
set title $options(aframe)
} else {
set title ""
}
# Export the diagram.
#
set type [string toupper [[$diag file] type]]
set printOut [${type}PrintOut new -diagram $diag]
if {$type == "CAD"} {
$printOut config \
-configVersion $configV \
-systemVersion $systemV \
}
Export::setOptions $printOut options
if [catch {
$printer printEncapsulated $printOut $title $file $exportType
} msg] {
error $msg
}
$printer delete
puts "Done"
}
proc Export::processOptions {options_array index argv} {
upvar $options_array options
upvar $index i
foreach opt ${Export::options} {
set $opt ""
set isOpt($opt) 1
}
set argc [llength $argv]
for {set i 0} {$i < $argc} {incr i} {
set arg [lindex $argv $i]
if {[string range $arg 0 0] != "-"} {
break
}
set opt [string range $arg 1 end]
if {![info exists isOpt($opt)]} {
error "unknown option $arg"
}
incr i
set options($opt) [lindex $argv $i]
}
}
# Set print options in $printOut. Command line options in 'options_array'
# override options saved in the diagram, which override the defaults.
#
proc Export::setOptions {printOut options_array} {
upvar $options_array options
set diag [$printOut diagram]
set props [PIPropInfo new]
$props load $diag
if [info exists options(orientation)] {
$printOut landscape [expr {$options(orientation) == "landscape"}]
} else {
set landscape [$props getProperty M4_ps_mode]
if {$landscape != ""} {
$printOut landscape [expr {$landscape == "landscape"}]
}
}
$props delete
if [info exists options(aframe)] {
$printOut title $options(aframe)
} else {
$printOut title "20"
}
$printOut doInfoBox 0
$printOut horNumPages 1
$printOut verNumPages 1
$printOut autoScale 1
}
# Set the client context to the command parameters. The resulting
# level_path must be at system level.
#
proc Export::setContext {options_array} {
upvar $options_array options
set cc_corporate_name ""
set cc_project_name ""
set cc_config_name ""
set cc_phase_name ""
set cc_system_name ""
set cc [ClientContext::global]
if [info exists options(corporate)] {
set cc_corporate_name $options(corporate)
} else {
set cc_corporate [$cc currentCorporate]
if {![$cc_corporate isNil]} {
set cc_corporate_name [$cc_corporate name]
} else {
error "otexport requires -corporate option"
}
}
if [info exists options(project)] {
set cc_project_name $options(project)
} else {
set cc_project [$cc currentProject]
if {![$cc_project isNil]} {
set cc_project_name [$cc_project name]
} else {
error "otexport requires -project option"
}
}
if [info exists options(config)] {
set cc_config_name $options(config)
} else {
set cc_config [$cc currentConfig]
if {![$cc_config isNil]} {
set cc_config_name [[$cc_config config] name]:[$cc_config versionName]
} else {
error "otexport requires -config option"
}
}
if [info exists options(phase)] {
set cc_phase_name $options(phase)
} else {
set cc_phase [$cc currentPhase]
if {![$cc_phase isNil]} {
set cc_phase_name [[$cc_phase phase] name].[[$cc_phase phase] type]
} else {
error "otexport requires -phase option"
}
}
if [info exists options(system)] {
set cc_system_name $options(system).system
} else {
set cc_system [$cc currentSystem]
if {![$cc_system isNil]} {
set cc_system_name [[$cc_system system] name].system
} else {
error "otexport requires -system option"
}
}
set cc_phase_type [lindex [split $cc_phase_name "."] 1]
if { $cc_phase_type == "" } {
set cc_phase_name $cc_phase_name.$cc_phase_name
}
$cc setLevelPath /$cc_corporate_name
$cc downLevel $cc_project_name
$cc downLevel $cc_config_name
$cc downLevel $cc_phase_name
$cc downLevel $cc_system_name
}
eval Export::exportDiagram $argv