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 >
Text File  |  1997-10-10  |  6KB  |  244 lines

  1. #include <iostream.h>
  2. #---------------------------------------------------------------------------
  3. #
  4. #      (c)     Westmount Technology    1994
  5. #
  6. #      File:           @(#)export.tcl    /main/titanic/2
  7. #      Author:         <generated>
  8. #      Description:
  9. #---------------------------------------------------------------------------
  10. # SccsId = @(#)export.tcl    /main/titanic/2   10 Oct 1997 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 uiFileName [lindex $args $i]
  56.     regsub : $uiFileName / fileName
  57.     incr i
  58.     set fileType [lindex $args $i]
  59.  
  60.     set context [ClientContext::global]
  61.     set configV [$context currentConfig]
  62.     set systemV [$context currentSystem]
  63.     set diag [$systemV findFileVersion $fileName $fileType]    
  64.     if [$diag isNil] {
  65.         error "diagram '$uiFileName.$fileType' not found"
  66.     }
  67.  
  68.     puts "Exporting diagram '$uiFileName.$fileType' ..."
  69.     # Configure Exporter.
  70.     #
  71.     set printer [Printer new]
  72.     if [info exists options(width)] {
  73.         $printer pageWidth $options(width)
  74.     }
  75.     if [info exists options(height)] {
  76.         $printer pageHeight $options(height)
  77.     }
  78.     if {![info exists options(file)]} {
  79.         error "exportDiagram needs -file option"
  80.     }
  81.     set file $options(file)
  82.     if {![info exists options(format)]} {
  83.         error "exportDiagram needs -format option"
  84.     }
  85.     set exportType [string toupper $options(format)]
  86.     if [info exists options(aframe)] {
  87.         set title $options(aframe)
  88.     } else {
  89.         set title ""
  90.     }
  91.  
  92.  
  93.     # Export the diagram.
  94.     #
  95.     set type [string toupper [[$diag file] type]]
  96.     set printOut [${type}PrintOut new -diagram $diag]
  97.     if {$type == "CAD"} {
  98.         $printOut config \
  99.             -configVersion $configV \
  100.             -systemVersion $systemV \
  101.     }
  102.     Export::setOptions $printOut options
  103.     if [catch {
  104.         $printer printEncapsulated $printOut $title $file $exportType
  105.     } msg] {
  106.         error $msg
  107.     }
  108.     $printer delete
  109.     puts "Done"
  110. }
  111.  
  112. proc Export::processOptions {options_array index argv} {
  113.     upvar $options_array options
  114.     upvar $index i
  115.     foreach opt ${Export::options} {
  116.         set $opt ""
  117.         set isOpt($opt) 1
  118.     }
  119.     set argc [llength $argv]
  120.     for {set i 0} {$i < $argc} {incr i} {
  121.         set arg [lindex $argv $i]
  122.         if {[string range $arg 0 0] != "-"} {
  123.             break
  124.         }
  125.         set opt [string range $arg 1 end]
  126.         if {![info exists isOpt($opt)]} {
  127.             error "unknown option $arg"
  128.         }
  129.         incr i
  130.         set options($opt) [lindex $argv $i]
  131.     }
  132. }
  133.  
  134.  
  135. # Set print options in $printOut. Command line options in 'options_array'
  136. # override options saved in the diagram, which override the defaults.
  137. #
  138. proc Export::setOptions {printOut options_array} {
  139.     upvar $options_array options
  140.     set diag [$printOut diagram]
  141.     set props [PIPropInfo new]
  142.     $props load $diag
  143.     if [info exists options(orientation)] {
  144.         $printOut landscape [expr {$options(orientation) == "landscape"}]
  145.     } else {
  146.         set landscape [$props getProperty M4_ps_mode]
  147.         if {$landscape != ""} {
  148.             $printOut landscape [expr {$landscape == "landscape"}]
  149.         }
  150.     }
  151.     $props delete
  152.  
  153.     if [info exists options(aframe)] {
  154.         $printOut title $options(aframe)
  155.     } else {
  156.         $printOut title "20"
  157.     }
  158.  
  159.     $printOut doInfoBox   0
  160.     $printOut horNumPages 1
  161.     $printOut verNumPages 1
  162.     $printOut autoScale   1
  163. }
  164.  
  165. # Set the client context to the command parameters.  The resulting 
  166. # level_path must be at system level.
  167. #
  168. proc Export::setContext {options_array} {
  169.     upvar $options_array options
  170.  
  171.     set cc_corporate_name ""
  172.     set cc_project_name   ""
  173.     set cc_config_name    ""
  174.     set cc_phase_name     ""
  175.     set cc_system_name    ""
  176.  
  177.     set cc [ClientContext::global]
  178.  
  179.     if [info exists options(corporate)] {
  180.         set cc_corporate_name $options(corporate)
  181.     } else {
  182.             set cc_corporate [$cc currentCorporate]
  183.         if {![$cc_corporate isNil]} {
  184.             set cc_corporate_name [$cc_corporate name]
  185.         } else {
  186.             error "otexport requires -corporate option"
  187.         }
  188.     }
  189.     if [info exists options(project)] {
  190.         set cc_project_name $options(project)
  191.     } else {
  192.             set cc_project [$cc currentProject]
  193.         if {![$cc_project isNil]} {
  194.             set cc_project_name [$cc_project name]
  195.         } else {
  196.             error "otexport requires -project option"
  197.         }
  198.     }
  199.     if [info exists options(config)] {
  200.         set cc_config_name $options(config)
  201.     } else {
  202.             set cc_config [$cc currentConfig]
  203.         if {![$cc_config isNil]} {
  204.             set cc_config_name [[$cc_config config] name]:[$cc_config versionName]
  205.         } else {
  206.             error "otexport requires -config option"
  207.         }
  208.     }
  209.     if [info exists options(phase)] {
  210.         set cc_phase_name $options(phase)
  211.     } else {
  212.             set cc_phase [$cc currentPhase]
  213.         if {![$cc_phase isNil]} {
  214.             set cc_phase_name [[$cc_phase phase] name].[[$cc_phase phase] type]
  215.         } else {
  216.             error "otexport requires -phase option"
  217.         }
  218.     }
  219.     if [info exists options(system)] {
  220.         set cc_system_name $options(system).system
  221.     } else {
  222.             set cc_system [$cc currentSystem]
  223.         if {![$cc_system isNil]} {
  224.             set cc_system_name [[$cc_system system] name].system
  225.         } else {
  226.             error "otexport requires -system option"
  227.         }
  228.     }
  229.     set cc_phase_type [lindex [split $cc_phase_name "."]    1]
  230.     if { $cc_phase_type == "" } {
  231.         set cc_phase_name $cc_phase_name.$cc_phase_name
  232.     }
  233.  
  234.     $cc setLevelPath /$cc_corporate_name
  235.     $cc downLevel $cc_project_name
  236.     $cc downLevel $cc_config_name
  237.     $cc downLevel $cc_phase_name
  238.     $cc downLevel $cc_system_name
  239. }
  240.  
  241. eval Export::exportDiagram $argv
  242.  
  243.  
  244.