home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / export.tcl < prev    next >
Text File  |  1996-10-16  |  6KB  |  243 lines
  1. #include <iostream.h>
  2. #---------------------------------------------------------------------------
  3. #
  4. #      (c)     Westmount Technology    1994
  5. #
  6. #      File:           @(#)export.tcl    /main/hindenburg/1
  7. #      Author:         <generated>
  8. #      Description:
  9. #---------------------------------------------------------------------------
  10. # SccsId = @(#)export.tcl    /main/hindenburg/1   16 Oct 1996 Copyright 1994 Westmount Technology
  11.  
  12. # Start user added include file section
  13.  
  14. global Export::options
  15. set Export::options {
  16.     orientation width height file format aframe
  17.     project config phase system  
  18. }
  19.  
  20. # End user added include file section
  21.  
  22.  
  23. Class Export : {Object} {
  24.     constructor
  25.     method destructor
  26. }
  27.  
  28. constructor Export {class this name} {
  29.     set this [Object::constructor $class $this $name]
  30.     # Start constructor user section
  31.     # End constructor user section
  32.     return $this
  33. }
  34.  
  35. method Export::destructor {this} {
  36.     # Start destructor user section
  37.     # End destructor user section
  38. }
  39.  
  40. # Export a diagram to a file in a certain format.
  41. #
  42. proc Export::exportDiagram {args} {
  43.     Export::processOptions options i $args
  44.     Export::setContext options
  45.     if { [expr [llength $args] - $i] == 0  } {
  46.         error "requires diagram name and type"
  47.     }
  48.     if { [expr [llength $args] - $i] == 1  } {
  49.         error "requires diagram type"
  50.     }
  51.     if { [expr [llength $args] - $i] > 2  } {
  52.         error "too many arguments"
  53.     }
  54.  
  55.     set fileName [lindex $args $i]
  56.     incr i
  57.     set fileType [lindex $args $i]
  58.  
  59.     set context [ClientContext::global]
  60.     set configV [$context currentConfig]
  61.     set systemV [$context currentSystem]
  62.     set diag [$systemV findFileVersion $fileName $fileType]    
  63.     if [$diag isNil] {
  64.         error "diagram '$fileName.$fileType' not found"
  65.     }
  66.  
  67.     puts "Exporting diagram '$fileName.$fileType' ..."
  68.     # Configure Exporter.
  69.     #
  70.     set printer [Printer new]
  71.     if [info exists options(width)] {
  72.         $printer pageWidth $options(width)
  73.     }
  74.     if [info exists options(height)] {
  75.         $printer pageHeight $options(height)
  76.     }
  77.     if {![info exists options(file)]} {
  78.         error "exportDiagram needs -file option"
  79.     }
  80.     set file $options(file)
  81.     if {![info exists options(format)]} {
  82.         error "exportDiagram needs -format option"
  83.     }
  84.     set exportType [string toupper $options(format)]
  85.     if [info exists options(aframe)] {
  86.         set title $options(aframe)
  87.     } else {
  88.         set title ""
  89.     }
  90.  
  91.  
  92.     # Export the diagram.
  93.     #
  94.     set type [string toupper [[$diag file] type]]
  95.     set printOut [${type}PrintOut new -diagram $diag]
  96.     if {$type == "CAD"} {
  97.         $printOut config \
  98.             -configVersion $configV \
  99.             -systemVersion $systemV \
  100.     }
  101.     Export::setOptions $printOut options
  102.     if [catch {
  103.         $printer printEncapsulated $printOut $title $file $exportType
  104.     } msg] {
  105.         error $msg
  106.     }
  107.     $printer delete
  108.     puts "Done"
  109. }
  110.  
  111. proc Export::processOptions {options_array index argv} {
  112.     upvar $options_array options
  113.     upvar $index i
  114.     foreach opt ${Export::options} {
  115.         set $opt ""
  116.         set isOpt($opt) 1
  117.     }
  118.     set argc [llength $argv]
  119.     for {set i 0} {$i < $argc} {incr i} {
  120.         set arg [lindex $argv $i]
  121.         if {[string range $arg 0 0] != "-"} {
  122.             break
  123.         }
  124.         set opt [string range $arg 1 end]
  125.         if {![info exists isOpt($opt)]} {
  126.             error "unknown option $arg"
  127.         }
  128.         incr i
  129.         set options($opt) [lindex $argv $i]
  130.     }
  131. }
  132.  
  133.  
  134. # Set print options in $printOut. Command line options in 'options_array'
  135. # override options saved in the diagram, which override the defaults.
  136. #
  137. proc Export::setOptions {printOut options_array} {
  138.     upvar $options_array options
  139.     set diag [$printOut diagram]
  140.     set props [PIPropInfo new]
  141.     $props load $diag
  142.     if [info exists options(orientation)] {
  143.         $printOut landscape [expr {$options(orientation) == "landscape"}]
  144.     } else {
  145.         set landscape [$props getProperty M4_ps_mode]
  146.         if {$landscape != ""} {
  147.             $printOut landscape [expr {$landscape == "landscape"}]
  148.         }
  149.     }
  150.     $props delete
  151.  
  152.     if [info exists options(aframe)] {
  153.         $printOut title $options(aframe)
  154.     } else {
  155.         $printOut title "20"
  156.     }
  157.  
  158.     $printOut doInfoBox   0
  159.     $printOut horNumPages 1
  160.     $printOut verNumPages 1
  161.     $printOut autoScale   1
  162. }
  163.  
  164. # Set the client context to the command parameters.  The resulting 
  165. # level_path must be at system level.
  166. #
  167. proc Export::setContext {options_array} {
  168.     upvar $options_array options
  169.  
  170.     set cc_corporate_name ""
  171.     set cc_project_name   ""
  172.     set cc_config_name    ""
  173.     set cc_phase_name     ""
  174.     set cc_system_name    ""
  175.  
  176.     set cc [ClientContext::global]
  177.  
  178.     if [info exists options(corporate)] {
  179.         set cc_corporate_name $options(corporate)
  180.     } else {
  181.             set cc_corporate [$cc currentCorporate]
  182.         if {![$cc_corporate isNil]} {
  183.             set cc_corporate_name [$cc_corporate name]
  184.         } else {
  185.             error "otexport requires -corporate option"
  186.         }
  187.     }
  188.     if [info exists options(project)] {
  189.         set cc_project_name $options(project)
  190.     } else {
  191.             set cc_project [$cc currentProject]
  192.         if {![$cc_project isNil]} {
  193.             set cc_project_name [$cc_project name]
  194.         } else {
  195.             error "otexport requires -project option"
  196.         }
  197.     }
  198.     if [info exists options(config)] {
  199.         set cc_config_name $options(config)
  200.     } else {
  201.             set cc_config [$cc currentConfig]
  202.         if {![$cc_config isNil]} {
  203.             set cc_config_name [[$cc_config config] name]:[$cc_config versionName]
  204.         } else {
  205.             error "otexport requires -config option"
  206.         }
  207.     }
  208.     if [info exists options(phase)] {
  209.         set cc_phase_name $options(phase)
  210.     } else {
  211.             set cc_phase [$cc currentPhase]
  212.         if {![$cc_phase isNil]} {
  213.             set cc_phase_name [[$cc_phase phase] name].[[$cc_phase phase] type]
  214.         } else {
  215.             error "otexport requires -phase option"
  216.         }
  217.     }
  218.     if [info exists options(system)] {
  219.         set cc_system_name $options(system).system
  220.     } else {
  221.             set cc_system [$cc currentSystem]
  222.         if {![$cc_system isNil]} {
  223.             set cc_system_name [[$cc_system system] name].system
  224.         } else {
  225.             error "otexport requires -system option"
  226.         }
  227.     }
  228.     set cc_phase_type [lindex [split $cc_phase_name "."]    1]
  229.     if { $cc_phase_type == "" } {
  230.         set cc_phase_name $cc_phase_name.$cc_phase_name
  231.     }
  232.  
  233.     $cc setLevelPath /$cc_corporate_name
  234.     $cc downLevel $cc_project_name
  235.     $cc downLevel $cc_config_name
  236.     $cc downLevel $cc_phase_name
  237.     $cc downLevel $cc_system_name
  238. }
  239.  
  240. eval Export::exportDiagram $argv
  241.  
  242.  
  243.