home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / et.tcl < prev    next >
Encoding:
Text File  |  1997-11-28  |  46.1 KB  |  2,081 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. # Copyright (c) 1995 by Cadre Technologies Inc.
  4. #
  5. # This software is furnished under a license and may be used only in
  6. # accordance with the terms of such license and with the inclusion of
  7. # the above copyright notice. This software or any other copies thereof
  8. # may not be provided or otherwise made available to any other person.
  9. # No title to and ownership of the software is hereby transferred.
  10. #
  11. # The information in this software is subject to change without notice
  12. # and should not be construed as a commitment by Cadre Technologies Inc.
  13. #
  14. #---------------------------------------------------------------------------
  15. #
  16. #    File        : @(#)et.tcl    /main/titanic/11
  17. #    Author        : Discovery
  18. #    Original date    : June 1995
  19. #    Description    : Cadre TCL utilities
  20. #    Description    : Tcl Script to generate file in import tool format
  21. #              The client context (M4_levelpath) should be set to
  22. #              the diagram for which a script should be generated
  23. #    Command line
  24. #     options    :
  25. #          -a<file>    append output to file <file>
  26. #          -x | -e     create CDM's explicitly (see -i option)
  27. #          -f<id>      before exporting, do a downLevel to file with
  28. #              identity <id>, e.g.
  29. #              -fGraph:Uj0DhZzJTWPoAAAAzAGcAAQAAABYA
  30. #          -g          global view, don't export properties of
  31. #              scopePhaseRef workitems
  32. #          -i          create CDM's implicitly from within CAD's
  33. #          -l          local view, export all properties
  34. #          -d<level>   use defaults ("") upto (including) <level>
  35. #                      level can be "proj", "conf", "phase" or "system"
  36. #          -o<file>    write output to file <file>
  37. #          -vi<ver>    set input version to <ver>, e.g. -vi4000
  38. #          -vo<ver>    set output version to <ver>
  39. #
  40. #          defaults    : -i -l -ostdout -vi<current_ver> -vo<current_ver>
  41. #          hint    : When exporting an entire Phase, use both '-g'
  42. #              and '-e' option for all of its FileVersions.
  43. #    Usage        : otsh <otsh_options> -- <et.tcl_options>
  44. #
  45. #---------------------------------------------------------------------------
  46. #
  47. # @(#)et.tcl    /main/titanic/11 28 Nov 1997 Copyright 1996 Cadre Technologies Inc.
  48. #
  49. #---------------------------------------------------------------------------
  50.  
  51. global SCCS_W;        set SCCS_W "
  52. @(#)et.tcl    /main/titanic/11
  53. "
  54.  
  55. global compCount;    set compCount 0
  56. global compCache
  57. global etCache
  58. global cdmCache
  59. global lblConv
  60. global outFile
  61.  
  62. global clientContext;    set clientContext [ClientContext::global]
  63.  
  64. #
  65. #    escapeStr:
  66. #
  67. #    For an input string, escape characters with a special meaning in
  68. #    TCL, i.e. '[', ']', '$', '"' and '\n'.
  69. #
  70.  
  71. proc escapeStr {{str ""}} {
  72.     set q "\\\\"
  73.     set newStr ""
  74.     set esc 0
  75.     set len [string length $str]
  76.     for {set i 0} {$i < $len} {incr i} {
  77.     set c [string index $str $i]
  78.     if {$c == {-}} {set c "X-"}
  79.     switch -exact "$c" {
  80.         "\\" {
  81.         if {$esc} {
  82.             set newStr "${newStr}${q}${q}"
  83.             set esc 0
  84.         } else {
  85.             set esc 1
  86.         }
  87.         }
  88.         "\n" {
  89.         if {$esc} {
  90.             set newStr "${newStr}${q}\\n"
  91.             set esc 0
  92.         } else {
  93.             set newStr "${newStr}\\n"
  94.         }
  95.         }
  96.         "X-" {
  97.         if {$esc} {
  98.             set newStr "${newStr}${q}-"
  99.             set esc 0
  100.         } else {
  101.             set newStr "${newStr}-"
  102.         }
  103.         }
  104.         {[} -
  105.         {]} -
  106.         {"} -
  107.         {$} {
  108.         if {$esc} {
  109.             set newStr "${newStr}${q}\\$c"
  110.             set esc 0
  111.         } else {
  112.             set newStr "${newStr}\\$c"
  113.         }
  114.         }
  115.         "n" {
  116.         if {$esc} {
  117.             set newStr "${newStr}${q}$c"
  118.             set esc 0
  119.         } else {
  120.             set newStr "${newStr}$c"
  121.         }
  122.         }
  123.         default {
  124.         if {$esc} {
  125.             set newStr "${newStr}${q}$c"
  126.             set esc 0
  127.         } else {
  128.             set newStr "${newStr}$c"
  129.         }
  130.         }
  131.     }
  132.     }
  133.     return $newStr
  134. }
  135.  
  136. proc cc_hack {} {
  137.     global verOut
  138.     if {$verOut < 5100} {
  139.     puts $outFile "if {\[\[ClientContext::global\] currentLevel\] == \"File\"} {\[ClientContext::global\] upLevel}"
  140.     }
  141. }
  142.  
  143. proc fileHasScopePhase {clientContext} {
  144.     set configV [$clientContext currentConfig]
  145.     set systemV [$clientContext currentSystem]
  146.     set fileV [$clientContext currentFile]
  147.     set fwitem [$systemV findDeclaration [[$fileV file] item] $configV]
  148.     if {[$fwitem scope] == "scopeSystem"} { return 0 }
  149.     return 1
  150. }
  151.  
  152. #
  153. #    4000 -> 4001+ label conversion
  154. #
  155.  
  156. proc initLabelConv {} {
  157.     global lblConv readOnlyLbl
  158.     set lblConv(link_attrib:name)    name_type
  159.     set lblConv(link_attrib:type)    name_type
  160.     set lblConv(link_attrib:modifiers)    name_type
  161.     set lblConv(link_attrib:colon)    name_type
  162.     set lblConv(link_attrib:init_value)    name_type
  163.     set lblConv(attribute:name)        name_type
  164.     set lblConv(attribute:type)        name_type
  165.     set lblConv(attribute:modifiers)    name_type
  166.     set lblConv(attribute:colon)    name_type
  167.     set lblConv(attribute:init_value)    name_type
  168.     set lblConv(method:name)        name_type
  169.     set lblConv(method:type)        name_type
  170.     set lblConv(method:modifiers)    name_type
  171.     set lblConv(method:left_parenth)    name_type
  172.     set lblConv(method:right_parenth)    name_type
  173.     set lblConv(method:colon)        name_type
  174.     set lblConv(method:constraint)    name_type
  175.     set lblConv(parameter:name)        name_type
  176.     set lblConv(parameter:type)        name_type
  177.     set lblConv(parameter:colon)    name_type
  178.     set lblConv(parameter:comma)    name_type
  179.     set lblConv(etd_object:name)    name_type
  180.     set lblConv(etd_object:type)    name_type
  181.     set lblConv(etd_object:colon)    name_type
  182.     set lblConv(etd_initiator:name)    name_type
  183.     set lblConv(etd_initiator:type)    name_type
  184.     set lblConv(etd_initiator:colon)    name_type
  185.     set lblConv(activity:do)        name
  186.     #
  187.     #                    Boolean    0/1
  188.     set readOnlyLbl(etd_object:editor_only)    1
  189.     set readOnlyLbl(etd_initiator:editor_only)    1
  190. }
  191.  
  192. #
  193. #    Return nodes and connectors in sorted order to prevent the generation
  194. #    of forward references.
  195. #
  196.  
  197. proc getSortedObjects {} {
  198.     set sortedObjects ""
  199.  
  200.     foreach i {0 1} {
  201.     foreach expNode $exportNodeList {
  202.         if {[$expNode delayed] == $i} {
  203.         lappend sortedObjects $expNode
  204.         }
  205.     }
  206.     }
  207.  
  208.     foreach i {0 1} {
  209.     foreach expConn $exportConnList {
  210.         if {[$expConn delayed] == $i} {
  211.         lappend sortedObjects $expConn
  212.         }
  213.     }
  214.     }
  215.  
  216.     foreach i {0 1} {
  217.     foreach expCono $exportConoList {
  218.         if {[$expCono delayed] == $i} {
  219.         lappend sortedObjects $expCono
  220.         }
  221.     }
  222.     }
  223.  
  224.     foreach i {2 3} {
  225.     foreach expConn $exportConnList {
  226.         if {[$expConn delayed] == $i} {
  227.         lappend sortedObjects $expConn
  228.         }
  229.     }
  230.     }
  231.  
  232.     return $sortedObjects
  233. }
  234.  
  235. #
  236. #    ExportObject:
  237. #
  238. #    Base class for all export objects
  239. #
  240.  
  241. Class ExportObject : GCObject {
  242.     #
  243.     # Repository object for this Export Object
  244.     #
  245.     attribute repObject
  246.     #
  247.     # Name used for this object in generated script
  248.     #
  249.     attribute exportName
  250.  
  251.     constructor
  252.  
  253.     method addLabels
  254.     method addProperties
  255. }
  256.  
  257. constructor ExportObject {class object name dbComp} {
  258.     set this [GCObject::constructor $class $object]
  259.  
  260.     global compCount
  261.     incr compCount
  262.  
  263.     $this repObject $dbComp
  264.     $this exportName $name$compCount
  265.  
  266.     global compCache
  267.     set compCache($dbComp) [$this exportName]
  268.     global etCache
  269.     set etCache($dbComp) $this
  270.  
  271.     return $this
  272. }
  273.  
  274. method ExportObject::addLabels {this {comp ""}} {
  275.     if {$comp == ""} {
  276.     set comp [$this repObject]
  277.     }
  278.  
  279.     foreach label [$comp labels] {
  280.     set compType [$comp type]
  281.     if {$compType == "Segment"} {
  282.         if {[[$this repObject] type] == "Segment"} {
  283.         set compType [[[$this connector] repObject] type]
  284.         } else {
  285.         set compType [[$this repObject] type]
  286.         }
  287.     }
  288.     set labelType [$label type]
  289.  
  290.     global readOnlyLbl
  291.     if {[info exists readOnlyLbl($compType:$labelType)]} {
  292.         set put [expr 1 - $readOnlyLbl($compType:$labelType)]
  293.     } else {
  294.         set put 1
  295.     }
  296.     if {$put} {
  297.         puts $outFile "\$[$this exportName] setLabel \"$labelType\" \"[escapeStr [$label value]]\""
  298.     }
  299.     }
  300. }
  301.  
  302. method ExportObject::addProperties {this {comp ""}} {
  303.     if {$comp == ""} {
  304.     set comp [$this repObject]
  305.     }
  306.  
  307.     #
  308.     #    Component properties
  309.     #
  310.  
  311.     foreach prop [$comp properties] {
  312.     puts $outFile "\$[$this exportName] setProp \"[$prop name]\" \"[escapeStr [$prop value]]\""
  313.     }
  314.  
  315.     #
  316.     #    Item Properties
  317.     #
  318.  
  319.     global globalView
  320.  
  321.     set configV [$clientContext currentConfig]
  322.  
  323.     foreach label [$comp labels] {
  324.     foreach itemRef [$label itemRefs] {
  325.         set item [$itemRef item]
  326.         if {[$item isNil]} {
  327.         continue
  328.         }
  329.  
  330.         set diag [$itemRef diagram]
  331.         set workitem [$diag findDeclaration $item $configV]
  332.         if {[$workitem isNil]} {
  333.         continue
  334.         }
  335.  
  336.         global lblConv
  337.         set compType [$comp type]
  338.         set labelType [$label type]
  339.         if {[info exists lblConv($compType:$labelType)]} {
  340.         set labelType $lblConv($compType:$labelType)
  341.         }
  342.  
  343.         set scopeKey "$labelType:[$workitem type]"
  344.         if {![info exists scoped($scopeKey)]} {
  345.         set scoped($scopeKey) ""
  346.         # qualified items inherit their scope from the qualifier
  347.         if {[[$item qualifier] isNil]} {
  348.             set scope [$workitem scope]
  349.  
  350.             if {$scope == "scopePhaseDef" || $scope == "scopePhaseRef"} {
  351.             set scope scopePhase
  352.             }
  353.  
  354.             puts $outFile "\$[$this exportName] setScope \"$labelType\" \"[$workitem type]\" \"$scope\""
  355.  
  356.             if {$globalView && [$workitem scope] == "scopePhaseRef"} {
  357.             return
  358.             }
  359.         }
  360.         }
  361.  
  362.  
  363.         set propObj [$workitem properties]
  364.         if {[$propObj isNil]} {
  365.         continue
  366.         }
  367.         foreach prop [$propObj properties] {
  368.         puts $outFile "\$[$this exportName] setProp \"[$prop name]\" \"[escapeStr [$prop value]]\" \"$labelType\" \"[$workitem type]\""
  369.         }
  370.     }
  371.     }
  372. }
  373.  
  374. #
  375. #    Static member getExportObject
  376. #
  377.  
  378. proc ExportObject__getExportObject {dbObject} {
  379.     if {[info exists compCache($dbObject)]} {
  380.     return $compCache($dbObject)
  381.     }
  382.  
  383.     return ""
  384.     #
  385.     #    Assume from object is segment, while we need a connector
  386.     #
  387.     #return $compCache([$dbObject connector])
  388. }
  389.  
  390.  
  391. #
  392. #    ExportSegm
  393. #
  394. #    Class used to export segments
  395. #    A segment is just as much delayed as its connector is.
  396. #
  397.  
  398. Class ExportSegm : ExportObject {
  399.     attribute isFirst
  400.  
  401.     attribute connector
  402.  
  403.     constructor
  404.  
  405.     method generate
  406. }
  407.  
  408. constructor ExportSegm {class object dbSegm conn {inIsFirst 0}} {
  409.     set this [ExportObject::constructor $class $object segm $dbSegm]
  410.  
  411.     $this isFirst $inIsFirst
  412.  
  413.     $this connector $conn
  414.  
  415.     return $this
  416. }
  417.  
  418. method ExportSegm::generate {this} {
  419.     set segm [$this repObject]
  420.     if {[$this isFirst]} {
  421.     puts $outFile "set [$this exportName] \[\$[[$this connector] exportName] getFirstSegm\]"
  422.     } else {
  423.     puts $outFile "set [$this exportName] \[\$[[$this connector] exportName] addSegm [$segm startX] [$segm startY]\]"
  424.     }
  425.     $this addLabels
  426.     $this addProperties
  427. }
  428.  
  429.  
  430. global exportConnList;    set exportConnList ""
  431.  
  432. #
  433. #    ExportConn
  434. #
  435. #    Class used to export connectors
  436. #    A connector can be 'delayed', i.e. it can be a connector connected
  437. #    to other connectors. Since we need to identify the objects the
  438. #    connector connects, they must have been created before we can
  439. #    create the connector. So the generation of certain connectors (e.g.
  440. #    the loop connector in a CAD) is delayed until after all normal
  441. #    connectors have been processed.
  442. #
  443.  
  444. Class ExportConn : ExportObject {
  445.     attribute delayed
  446.  
  447.     attribute segmentList
  448.  
  449.     constructor
  450.  
  451.     method generate
  452. }
  453.  
  454. constructor ExportConn {class object dbConn} {
  455.     set this [ExportObject::constructor $class $object conn $dbConn]
  456.  
  457.     case [$dbConn type] {
  458.     {note_conn} {
  459.         $this delayed 3
  460.     }
  461.     {etd_event} {
  462.         $this delayed 2
  463.     }
  464.     {constraint event_msg loop} {
  465.         $this delayed 1
  466.     }
  467.     default {
  468.         $this delayed 0
  469.     }
  470.     }
  471.  
  472.     #
  473.     # create ordered list of segments
  474.     # first, search for first segment (has no previous segment)
  475.     # then, add all its following segments
  476.     #
  477.     set conn [$this repObject]
  478.     foreach segm [$conn segments] {
  479.     set prev [$segm previous]
  480.     if {[$prev isNil]} {
  481.         lappend tmpList [ExportSegm new $segm $this 1]
  482.         break
  483.     }
  484.     }
  485.     while {![[$segm next] isNil] } {
  486.     set segm [$segm next]
  487.     lappend tmpList [ExportSegm new $segm $this 0]
  488.     }
  489.     $this segmentList $tmpList
  490.  
  491.     global exportConnList
  492.     lappend exportConnList $this
  493.  
  494.     return $this
  495. }
  496.  
  497. method ExportConn::generate {this {genNew 1}} {
  498.     set conn [$this repObject]
  499.     set expFromObject [ExportObject__getExportObject [$conn from]]
  500.     set expToObject [ExportObject__getExportObject [$conn to]]
  501.  
  502.     #set segment [lindex [$conn segments] 0]
  503.     set segment [[lindex [$this segmentList] 0] repObject]
  504.  
  505.     if {$genNew} {
  506.     puts $outFile ""
  507.     puts $outFile "set [$this exportName] \[\$diag addConn [$conn type] \$$expFromObject \$$expToObject [$segment startX] [$segment startY] [$conn endX] [$conn endY]\]"
  508.     }
  509.  
  510.     $this addLabels
  511.     $this addProperties
  512.  
  513.     #foreach segment [$conn segments] { $this addLabels $segment }
  514.     foreach segment [$this segmentList] {
  515.     $segment generate
  516.     }
  517. }
  518.  
  519. global exportConoList;    set exportConoList ""
  520.  
  521. #
  522. #    ExportCono
  523. #
  524. #    Export class for connected nodes. A cono is delayed when its super
  525. #    component is also a cono and when this super cono is not generated yet.
  526. #
  527.  
  528. Class ExportCono : ExportObject {
  529.     attribute delayed
  530.  
  531.     attribute generated
  532.  
  533.     attribute super
  534.  
  535.     constructor
  536.  
  537.     method generate
  538.  
  539.     method getSuper
  540. }
  541.  
  542. constructor ExportCono {class object dbCono} {
  543.     set this [ExportObject::constructor $class $object cono $dbCono]
  544.  
  545.     case [$dbCono type] {
  546.     {in_scope_region object_termination} {
  547.         $this delayed 1
  548.     }
  549.     default {
  550.         $this delayed 0
  551.     }
  552.     }
  553.  
  554.     $this generated 0
  555.     $this super ""
  556.  
  557.     #
  558.     # sort exportConoList on x coordinate
  559.     #
  560.  
  561.     global exportConoList
  562.  
  563.     set cono [$this repObject]
  564.     set x [$cono x]
  565.     set l [llength $exportConoList]
  566.  
  567.     for {set i 0} {$i < $l} {incr i} {
  568.     set c [lindex $exportConoList $i]
  569.  
  570.     if {$x < [[$c repObject] x]} {
  571.         set exportConoList [linsert $exportConoList $i $this]
  572.         return $this
  573.     }
  574.     }
  575.  
  576.     lappend exportConoList $this
  577.  
  578.     return $this
  579. }
  580.  
  581. method ExportCono::generate {this} {
  582.     set super [$this getSuper]
  583.     set dbCono [$this repObject]
  584.     set superId [ExportObject__getExportObject [$super repObject]]
  585.  
  586.     puts $outFile ""
  587.     puts $outFile "set [$this exportName] \[\$diag addCono [$dbCono type] \$$superId [$dbCono x] [$dbCono y] [$dbCono sizeX] [$dbCono sizeY]\]"
  588.  
  589.     $this addLabels
  590.     $this addProperties
  591.  
  592.     return
  593. }
  594.  
  595. method ExportCono::getSuper {this} {
  596.     if {[$this super] != ""} {
  597.     return [$this super]
  598.     }
  599.  
  600.     set dbSuper [[$this repObject] from]
  601.  
  602.     if {[info exists etCache($dbSuper)]} {
  603.     $this super $etCache($dbSuper)
  604.     } elseif {[$dbSuper objType] == "ConnectedNode"} {
  605.     $this super $etCache($dbSuper)
  606.     }
  607.  
  608.     return [$this super]
  609. }
  610.  
  611. global exportNodeList;    set exportNodeList ""
  612.  
  613. #
  614. #    ExportNode
  615. #
  616. #    Export class for nodes. Nodes can be delayed because of composite
  617. #    nodes (e.g. generalization node + generalization connectors).
  618. #    These are delayed because the connectors connect to other nodes
  619. #    that must be generated first.
  620. #
  621.  
  622. Class ExportNode : ExportObject {
  623.     attribute delayed
  624.  
  625.     constructor
  626.  
  627.     method generate
  628. }
  629.  
  630. constructor ExportNode {class object dbNode {delay 0}} {
  631.     set this [ExportObject::constructor $class $object node $dbNode]
  632.  
  633.     $this delayed $delay
  634.  
  635.     global exportNodeList
  636.     lappend exportNodeList $this
  637.  
  638.     return $this
  639. }
  640.  
  641. method ExportNode::generate {this} {
  642.     set dbNode [$this repObject]
  643.  
  644.     puts $outFile ""
  645.     puts $outFile "set [$this exportName] \[\$diag addNode [$dbNode type] [$dbNode x] [$dbNode y] [$dbNode sizeX] [$dbNode sizeY]\]"
  646.  
  647.     $this addLabels
  648.     $this addProperties
  649. }
  650.  
  651. #
  652. #    ExportRow
  653. #
  654. #    Export class for rows.
  655. #
  656.  
  657. Class ExportRow : ExportObject {
  658.     constructor
  659.  
  660.     method generate
  661.     method exportCells
  662. }
  663.  
  664. constructor ExportRow {class object dbRow} {
  665.     set this [ExportObject::constructor $class $object row $dbRow]
  666.  
  667.     return $this
  668. }
  669.  
  670. method ExportRow::generate {this} {
  671.     set dbRow [$this repObject]
  672.  
  673.     puts $outFile ""
  674.     puts $outFile "set [$this exportName] \[\$diag addRow [$dbRow type] [$dbRow height]\]"
  675.  
  676.     $this addLabels
  677.     $this addProperties
  678.  
  679.     #
  680.     #    Workaround for problem in repository: cells are not sorted
  681.     #
  682.     #    foreach cell [$[$this repObject] rows]
  683.     #
  684.     set firstCell [lindex [[$this repObject] cells] 0]
  685.     set cellList ""
  686.     if {$firstCell != ""} {
  687.     while {![[$firstCell previous] isNil]} {
  688.         set firstCell [$firstCell previous]
  689.     }
  690.  
  691.     for {} {![$firstCell isNil]} {set firstCell [$firstCell next]} {
  692.         lappend cellList $firstCell
  693.     }
  694.     }
  695.  
  696.     $this exportCells $cellList
  697. }
  698.  
  699. method ExportRow::exportCells {this cellList } {
  700.     foreach cell $cellList {
  701.     [ExportCell new $cell $this] generate
  702.     }
  703. }
  704.  
  705. #
  706. #    ExportCell
  707. #
  708. #    Export class for cells of a row.
  709. #
  710.  
  711. Class ExportCell : ExportObject {
  712.     attribute row
  713.  
  714.     constructor
  715.  
  716.     method generate
  717. }
  718.  
  719. constructor ExportCell {class object dbCell inRow} {
  720.     set this [ExportObject::constructor $class $object cell $dbCell]
  721.  
  722.     $this row $inRow
  723.  
  724.     return $this
  725. }
  726.  
  727. method ExportCell::generate {this} {
  728.     set dbCell [$this repObject]
  729.  
  730.     puts $outFile ""
  731.     puts $outFile "set [$this exportName] \[\$[[$this row] exportName] addCell [$dbCell type] [$dbCell width]\]"
  732.  
  733.     $this addLabels
  734.     $this addProperties
  735. }
  736.  
  737. #
  738. #    ExportCdmRow
  739. #
  740. #    Export class for CDM rows.
  741. #
  742.  
  743. Class ExportCdmRow : ExportRow {
  744.     constructor
  745.  
  746.     method exportCells
  747.     method addLabels
  748. }
  749.  
  750. constructor ExportCdmRow {class object dbRow} {
  751.     set this [ExportRow::constructor $class $object $dbRow]
  752.  
  753.     return $this
  754. }
  755.  
  756. method ExportCdmRow::exportCells {this cellList } {
  757.     global verIn verOut
  758.     if {$verIn == 4000 && $verOut >= 4001} {
  759.     foreach cell $cellList {
  760.         [ExportCdmCell new $cell $this] generate
  761.     }
  762.     } else {
  763.     foreach cell $cellList {
  764.         [ExportCell new $cell $this] generate
  765.     }
  766.     }
  767. }
  768.  
  769. method ExportCdmRow::addLabels {this {comp ""}} {
  770.     global verIn verOut
  771.     if {$verIn == 4000 && $verOut >= 4001} {
  772.     set _name ""
  773.     set _type ""
  774.     set _modifiers ""
  775.     set _left_parenth ""
  776.     set _right_parenth ""
  777.     set _colon ""
  778.     set _init_value ""
  779.     set _constraint ""
  780.  
  781.     if {$comp == ""} {
  782.         set comp [$this repObject]
  783.     }
  784.  
  785.     foreach label [$comp labels] {
  786.         set labelType [$label type]
  787.         set _$labelType [$label value]
  788.     }
  789.     if {[$comp type] == "attribute"} {
  790.         puts $outFile "\$[$this exportName] setLabel \"name_type\" \"[escapeStr "${_modifiers}${_name}${_colon}${_type}${_init_value}"]\""
  791.     } else {
  792.         puts $outFile "\$[$this exportName] setLabel \"name_type\" \"[escapeStr "${_modifiers}${_name}${_left_parenth}${_right_parenth}${_colon}${_type}${_constraint}"]\""
  793.     }
  794.     } else {
  795.     ExportObject::addLabels $this $comp
  796.     }
  797. }
  798.  
  799. #
  800. #    ExportCdmCell
  801. #
  802. #    Export class for cells of a Cdm row.
  803. #
  804.  
  805. Class ExportCdmCell : ExportCell {
  806.     constructor
  807.  
  808.     method addLabels
  809. }
  810.  
  811. constructor ExportCdmCell {class object dbCell inRow} {
  812.     set this [ExportCell::constructor $class $object $dbCell $inRow]
  813.  
  814.     return $this
  815. }
  816.  
  817. method ExportCdmCell::addLabels {this {comp ""}} {
  818.     global verIn verOut
  819.     if {$verIn == 4000 && $verOut >= 4001} {
  820.     set _name ""
  821.     set _type ""
  822.     set _colon ""
  823.     set _comma ""
  824.  
  825.     if {$comp == ""} {
  826.         set comp [$this repObject]
  827.     }
  828.  
  829.     foreach label [$comp labels] {
  830.         set labelType [$label type]
  831.         set _$labelType [$label value]
  832.     }
  833.     puts $outFile "\$[$this exportName] setLabel \"name_type\" \"[escapeStr "${_name}${_colon}${_type}${_comma}"]\""
  834.     } else {
  835.     ExportObject::addLabels $this $comp
  836.     }
  837. }
  838.  
  839. #
  840. #    ExportCadParam
  841. #
  842. #    Export object for a method parameter
  843. #
  844.  
  845. Class ExportCadParam : ExportObject {
  846.     attribute cadMethod
  847.  
  848.     constructor
  849.  
  850.     method generate
  851.     method addLabels
  852. }
  853.  
  854. constructor ExportCadParam {class object dbParam master} {
  855.     set this [ExportObject::constructor $class $object param $dbParam]
  856.  
  857.     $this cadMethod $master
  858.  
  859.     return $this
  860. }
  861.  
  862. method ExportCadParam::generate {this} {
  863.     global verOut
  864.     puts $outFile ""
  865.     puts -nonewline $outFile "set [$this exportName] \[\$[[$this cadMethod] exportName] addParam"
  866.     if {$verOut == 4000} {
  867.     puts $outFile " \"\" \"\" \"\" \"\"\]"
  868.     } else {
  869.     puts $outFile "\]"
  870.     }
  871.  
  872.     $this addLabels
  873.     $this addProperties
  874. }
  875.  
  876. method ExportCadParam::addLabels {this {comp ""}} {
  877.     global verIn verOut
  878.     if {$verIn == 4000 && $verOut >= 4001} {
  879.     set _name ""
  880.     set _type ""
  881.     set _colon ""
  882.     set _comma ""
  883.  
  884.     if {$comp == ""} {
  885.         set comp [$this repObject]
  886.     }
  887.  
  888.     foreach label [$comp labels] {
  889.         set labelType [$label type]
  890.         set _$labelType [$label value]
  891.     }
  892.     puts $outFile "\$[$this exportName] setLabel \"name_type\" \"[escapeStr "${_name}${_colon}${_type}${_comma}"]\""
  893.     } else {
  894.     ExportObject::addLabels $this $comp
  895.     }
  896. }
  897.  
  898. #
  899. #    ExportCadAttribute
  900. #
  901. #    Export object for a CAD attribute
  902. #
  903.  
  904. Class ExportCadAttribute : ExportObject {
  905.     attribute cadClass
  906.  
  907.     constructor
  908.  
  909.     method generate
  910.     method addLabels
  911. }
  912.  
  913. constructor ExportCadAttribute {class object dbObject master} {
  914.     set this [ExportObject::constructor $class $object attribute $dbObject]
  915.  
  916.     $this cadClass $master
  917.  
  918.     return $this
  919. }
  920.  
  921. method ExportCadAttribute::generate {this} {
  922.     global verOut
  923.     puts $outFile ""
  924.     puts -nonewline $outFile "set [$this exportName] \[\$[[$this cadClass] exportName] addAttrib"
  925.     if {$verOut == 4000} {
  926.     puts $outFile " \"\" \"\" \"\" \"\" \"\"\]"
  927.     } else {
  928.     puts $outFile "\]"
  929.     }
  930.  
  931.     $this addLabels
  932.     $this addProperties
  933. }
  934.  
  935. method ExportCadAttribute::addLabels {this {comp ""}} {
  936.     global verIn verOut
  937.     if {$verIn == 4000 && $verOut >= 4001} {
  938.     set _name ""
  939.     set _type ""
  940.     set _modifiers ""
  941.     set _colon ""
  942.     set _init_value ""
  943.  
  944.     if {$comp == ""} {
  945.         set comp [$this repObject]
  946.     }
  947.  
  948.     foreach label [$comp labels] {
  949.         set labelType [$label type]
  950.         set _$labelType [$label value]
  951.     }
  952.     puts $outFile "\$[$this exportName] setLabel \"name_type\" \"[escapeStr "${_modifiers}${_name}${_colon}${_type}${_init_value}"]\""
  953.     } else {
  954.     ExportObject::addLabels $this $comp
  955.     }
  956. }
  957.  
  958. #
  959. #    ExportCadMethod
  960. #
  961. #    Export object for a CAD method
  962. #
  963.  
  964. Class ExportCadMethod : ExportObject {
  965.     attribute cadClass
  966.  
  967.     constructor
  968.  
  969.     method generate
  970.     method addLabels
  971. }
  972.  
  973. constructor ExportCadMethod {class object dbObject master} {
  974.     set this [ExportObject::constructor $class $object method $dbObject]
  975.  
  976.     $this cadClass $master
  977.  
  978.     return $this
  979. }
  980.  
  981. method ExportCadMethod::generate {this} {
  982.     global verOut
  983.     puts $outFile ""
  984.     puts -nonewline $outFile "set [$this exportName] \[\$[[$this cadClass] exportName] addMethod"
  985.     if {$verOut == 4000} {
  986.     puts $outFile " \"\" \"\" \"\" \"\" \"\" \"\" \"\"\]"
  987.     } else {
  988.     puts $outFile "\]"
  989.     }
  990.  
  991.     $this addLabels
  992.     $this addProperties
  993.  
  994.     foreach cell [[$this repObject] cells] {
  995.     set param [ExportCadParam new $cell $this]
  996.     $param generate
  997.     }
  998. }
  999.  
  1000. method ExportCadMethod::addLabels {this {comp ""}} {
  1001.     global verIn verOut
  1002.     if {$verIn == 4000 && $verOut >= 4001} {
  1003.     set _name ""
  1004.     set _type ""
  1005.     set _modifiers ""
  1006.     set _left_parenth ""
  1007.     set _right_parenth ""
  1008.     set _colon ""
  1009.     set _constraint ""
  1010.  
  1011.     if {$comp == ""} {
  1012.         set comp [$this repObject]
  1013.     }
  1014.  
  1015.     foreach label [$comp labels] {
  1016.         set labelType [$label type]
  1017.         set _$labelType [$label value]
  1018.     }
  1019.     puts $outFile "\$[$this exportName] setLabel \"name_type\" \"[escapeStr "${_modifiers}${_name}${_left_parenth}${_right_parenth}${_colon}${_type}${_constraint}"]\""
  1020.     } else {
  1021.     ExportObject::addLabels $this $comp
  1022.     }
  1023. }
  1024.  
  1025. #
  1026. #    ExportCadClass
  1027. #
  1028. #    Special class for a CadClass: the CDM for this class must also be
  1029. #    loaded, to be able to generate methods and attributes.
  1030. #
  1031.  
  1032. Class ExportCadClass : ExportNode {
  1033.     constructor
  1034.  
  1035.     method generate
  1036. }
  1037.  
  1038. constructor ExportCadClass {class object dbObject} {
  1039.     set this [ExportNode::constructor $class $object $dbObject]
  1040.  
  1041.     return $this
  1042. }
  1043.  
  1044. method ExportCadClass::generate {this} {
  1045.     ExportNode::generate $this
  1046.  
  1047.     global explicitCreate
  1048.     if {$explicitCreate} {
  1049.     return
  1050.     }
  1051.  
  1052.     set node [$this repObject]
  1053.     set nodeName "noname"
  1054.  
  1055.     foreach label [$node labels] {
  1056.     if {[$label type] == "name"} {
  1057.         set nodeName [$label value]
  1058.     }
  1059.     }
  1060.  
  1061.     if {$nodeName == ""} {
  1062.     return
  1063.     }
  1064.  
  1065.     set systemV [$clientContext currentSystem]
  1066.     set fileV [$systemV findFileVersion $nodeName cdm]
  1067.  
  1068.     # CDM's are created only once per CAD
  1069.     global cdmCache
  1070.     if {![$fileV isNil] && ![info exists cdmCache($fileV)]} {
  1071.     set cdmCache($fileV) 1
  1072. #
  1073. #    Workaround for problem in repository: rows are not sorted
  1074. #
  1075. #    foreach row [$fileV rows]
  1076. #
  1077. set firstRow [lindex [$fileV rows] 0]
  1078. set rowList ""
  1079. if {$firstRow != ""} {
  1080.     while {![[$firstRow previous] isNil]} {
  1081.     set firstRow [$firstRow previous]
  1082.     }
  1083.  
  1084.     for {} {![$firstRow isNil]} {set firstRow [$firstRow next]} {
  1085.     lappend rowList $firstRow
  1086.     }
  1087. }
  1088.  
  1089.     foreach row $rowList {
  1090.         if {[$row type] == "attribute"} {
  1091.         set attribute [ExportCadAttribute new $row $this]
  1092.         $attribute generate
  1093.         }
  1094.  
  1095.         if {[$row type] == "method"} {
  1096.         set method [ExportCadMethod new $row $this]
  1097.         $method generate
  1098.         }
  1099.     }
  1100.     }
  1101. }
  1102.  
  1103. #
  1104. #    ExportCadLinkAttrib
  1105. #
  1106. #    Special class for a Link Attribute of a Link Attribute Box
  1107. #
  1108.  
  1109. Class ExportCadLinkAttrib : ExportCono {
  1110.     constructor
  1111.  
  1112.     method generate
  1113.     method addLabels
  1114. }
  1115.  
  1116. constructor ExportCadLinkAttrib {class object dbObject} {
  1117.     set this [ExportCono::constructor $class $object $dbObject]
  1118.  
  1119.     return $this
  1120. }
  1121.  
  1122. method ExportCadLinkAttrib::generate {this} {
  1123.     global verOut
  1124.     set superId [ExportObject__getExportObject [[$this repObject] from]]
  1125.  
  1126.     puts $outFile ""
  1127.     puts -nonewline $outFile "set [$this exportName] \[\$$superId addAttrib"
  1128.     if {$verOut == 4000} {
  1129.     puts $outFile " \"\" \"\" \"\" \"\" \"\"\]"
  1130.     } else {
  1131.     puts $outFile "\]"
  1132.     }
  1133.  
  1134.     $this addLabels
  1135.     $this addProperties
  1136. }
  1137.  
  1138. method ExportCadLinkAttrib::addLabels {this {comp ""}} {
  1139.     global verIn verOut
  1140.     if {$verIn == 4000 && $verOut >= 4001} {
  1141.     set _name ""
  1142.     set _type ""
  1143.     set _modifiers ""
  1144.     set _colon ""
  1145.     set _init_value ""
  1146.  
  1147.     if {$comp == ""} {
  1148.         set comp [$this repObject]
  1149.     }
  1150.  
  1151.     foreach label [$comp labels] {
  1152.         set labelType [$label type]
  1153.         set _$labelType [$label value]
  1154.     }
  1155.     puts $outFile "\$[$this exportName] setLabel \"name_type\" \"[escapeStr "${_modifiers}${_name}${_colon}${_type}${_init_value}"]\""
  1156.     } else {
  1157.     ExportObject::addLabels $this $comp
  1158.     }
  1159. }
  1160.  
  1161. #
  1162. #    ExportRakeNode
  1163. #
  1164. #    Special class for CAD and MGD generalization nodes
  1165. #
  1166.  
  1167. Class ExportRakeNode : ExportNode {
  1168.     constructor
  1169.  
  1170.     method generate
  1171. }
  1172.  
  1173. constructor ExportRakeNode {class object dbRake {delay 1}} {
  1174.     set this [ExportNode::constructor $class $object $dbRake $delay]
  1175.  
  1176.     return $this
  1177. }
  1178.  
  1179. method ExportRakeNode::generate {this} {
  1180.     global verOut
  1181.  
  1182.     set comp [$this repObject]
  1183.  
  1184.     set connectorsIn [$comp connectorsIn]
  1185.     set connectorsOut [$comp connectorsOut]
  1186.  
  1187.     set connIn [lvarpop connectorsIn]
  1188.     set connOut [lvarpop connectorsOut]
  1189.  
  1190.     if {($connIn == "") || ($connOut == "")} {
  1191.     puts stderr "WARNING: no code generated for generalization node"
  1192.     return ""
  1193.     }
  1194.  
  1195.     set baseClass [$connIn from]
  1196.     set derivedClass [$connOut to]
  1197.     set segment [lindex [$connIn segments] 0]
  1198.  
  1199.     puts $outFile ""
  1200.     puts $outFile "set [$this exportName] \[\$diag addRake [$comp type] \$$compCache($baseClass) \$$compCache($derivedClass) [$segment startX] [$segment startY] [$connOut endX] [$connOut endY] [$comp y]\]"
  1201.  
  1202.     $this addLabels
  1203.     $this addProperties
  1204.  
  1205.     #
  1206.     #    handle conn's
  1207.     #
  1208.     if {$verOut >= 4001} {
  1209.     set conn [ExportConn new $connIn]
  1210.     puts $outFile "\nset [$conn exportName] \[\$[$this exportName] getInConn\]"
  1211.     $conn generate 0
  1212.     }
  1213.     foreach conn $connectorsIn {
  1214.     [ExportConn new $conn] generate
  1215.     }
  1216.  
  1217.     if {$verOut >= 4001} {
  1218.     set conn [ExportConn new $connOut]
  1219.     puts $outFile "\nset [$conn exportName] \[\$[$this exportName] getFirstOutConn\]"
  1220.     $conn generate 0
  1221.     }
  1222.     foreach conn $connectorsOut {
  1223.     [ExportConn new $conn] generate
  1224.     }
  1225. }
  1226.  
  1227. #
  1228. #    ExportEtdNode
  1229. #
  1230. #    Export object for ETD nodes
  1231. #    Introduced for 4000 -> 4001 conversion
  1232. #
  1233.  
  1234. Class ExportEtdNode : ExportNode {
  1235.     constructor
  1236.  
  1237.     method addLabels
  1238. }
  1239.  
  1240. constructor ExportEtdNode {class object dbObject} {
  1241.     set this [ExportNode::constructor $class $object $dbObject]
  1242.  
  1243.     return $this
  1244. }
  1245.  
  1246. method ExportEtdNode::addLabels {this {comp ""}} {
  1247.     if {$verIn == 4000 && $verOut >= 4001} {
  1248.     set _name ""
  1249.     set _type ""
  1250.     set _colon ""
  1251.  
  1252.     if {$comp == ""} {
  1253.         set comp [$this repObject]
  1254.     }
  1255.  
  1256.     foreach label [$comp labels] {
  1257.         set labelType [$label type]
  1258.         set _$labelType [$label value]
  1259.     }
  1260.  
  1261.     # colon label must have a ':' in it, when there is a type label
  1262.     if {$verOut >= 7000 && [string trim $_colon] == "" && [string trim $_type] != ""} {
  1263.         set _colon ":"
  1264.     }
  1265.  
  1266.     puts $outFile "\$[$this exportName] setLabel \"name_type\" \"[escapeStr "${_name}${_colon}${_type}"]\""
  1267.     return
  1268.     }
  1269.  
  1270.     if {$verOut >= 7000} {
  1271.     # this should have been part of convert61to71...
  1272.     # name_type label must have a ':' in it, when there is a 'cl' itemref
  1273.     #
  1274.     if {$comp == ""} {
  1275.         set comp [$this repObject]
  1276.     }
  1277.  
  1278.     foreach label [$comp labels] {
  1279.         if {[$label type] != "name_type"} {
  1280.         continue
  1281.         }
  1282.         set value [$label value]
  1283.         if {![regexp ":" $value]} {
  1284.         foreach itemRef [$label itemRefs] {
  1285.             if {[$itemRef initialType] == "cl"} {
  1286.             puts $outFile "\$[$this exportName] setLabel \"name_type\" \"[escapeStr ":$value"]\""
  1287.             return
  1288.             }
  1289.         }
  1290.         }
  1291.     }
  1292.     }
  1293.  
  1294.     ExportObject::addLabels $this $comp
  1295. }
  1296.  
  1297. #
  1298. #    ExportStdCono
  1299. #
  1300. #    Special class for STD State Action and STD Activity
  1301. #
  1302.  
  1303. Class ExportStdCono : ExportCono {
  1304.     constructor
  1305.  
  1306.     method generate
  1307.     method addLabels
  1308. }
  1309.  
  1310. constructor ExportStdCono {class object dbObject} {
  1311.     set this [ExportCono::constructor $class $object $dbObject]
  1312.  
  1313.     return $this
  1314. }
  1315.  
  1316. method ExportStdCono::generate {this} {
  1317.     global verOut
  1318.     set dbCono [$this repObject]
  1319.     set superId [ExportObject__getExportObject [$dbCono from]]
  1320.     puts $outFile ""
  1321.     if {[$dbCono type] == "state_action"} {
  1322.     puts -nonewline $outFile "set [$this exportName] \[\$$superId addStateAction"
  1323.     if {$verOut == 4000} {
  1324.         puts $outFile " \"\" \"\" \"\"]"
  1325.     } else {
  1326.         puts $outFile "\]"
  1327.     }
  1328.     } elseif {[$dbCono type] == "activity"} {
  1329.     puts -nonewline $outFile "set [$this exportName] \[\$$superId addActivity"
  1330.     if {$verOut == 4000} {
  1331.         puts $outFile " \"\" \"\"\]"
  1332.     } else {
  1333.         puts $outFile "\]"
  1334.     }
  1335.     } elseif {[$dbCono type] == "state_attribute"} {
  1336.     #puts $outFile "set [$this exportName] \[\$$superId addAttrib \"\"\]"
  1337.     } else {
  1338.     puts $outFile "set [$this exportName] \[\$diag addCono [$dbCono type] \$$superId [$dbCono x] [$dbCono y] [$dbCono sizeX] [$dbCono sizeY]\]"
  1339.     }
  1340.  
  1341.     $this addLabels
  1342.     $this addProperties
  1343. }
  1344.  
  1345. method ExportStdCono::addLabels {this {comp ""}} {
  1346.     global verIn verOut
  1347.     if {$verIn == 4000 && $verOut >= 4001} {
  1348.     set _name ""
  1349.     set _do ""
  1350.  
  1351.     if {$comp == ""} {
  1352.         set comp [$this repObject]
  1353.     }
  1354.  
  1355.     foreach label [$comp labels] {
  1356.         set labelType [$label type]
  1357.         set _$labelType [$label value]
  1358.     }
  1359.     puts $outFile "\$[$this exportName] setLabel \"name\" \"[escapeStr "${_do}${_name}"]\""
  1360.     } else {
  1361.     ExportObject::addLabels $this $comp
  1362.     }
  1363. }
  1364.  
  1365. #
  1366. #    ExportCAD
  1367. #
  1368. #    Generate import tool script for this class
  1369. #
  1370.  
  1371. Class ExportCAD : GCObject {
  1372.     attribute fileV
  1373.  
  1374.     constructor
  1375.  
  1376.     method generate
  1377. }
  1378.  
  1379. constructor ExportCAD {class object fileVersion} {
  1380.     set this [GCObject::constructor $class $object]
  1381.  
  1382.     $this fileV $fileVersion
  1383.  
  1384.     return $this
  1385. }
  1386.  
  1387. method ExportCAD::generate {this} {
  1388.     putNewDiagram CAD
  1389.  
  1390.     foreach node [[$this fileV] nodes] {
  1391.     case [$node type] {
  1392.         {cad_class cad_container} {
  1393.         ExportCadClass new $node
  1394.         }
  1395.         {generalization overlap_gen} {
  1396.         ExportRakeNode new $node
  1397.         }
  1398.         default {
  1399.         ExportNode new $node
  1400.         }
  1401.     }
  1402.     }
  1403.  
  1404.     foreach conn [[$this fileV] connectors] {
  1405.     case [$conn type] {
  1406.         {generalization_conn overlap_gen_conn} {
  1407.         continue
  1408.         }
  1409.         default {
  1410.         ExportConn new $conn
  1411.         }
  1412.     }
  1413.     }
  1414.  
  1415.     foreach cono [[$this fileV] connectedNodes] {
  1416.     case [$cono type] {
  1417.         {link_attrib} {
  1418.         ExportCadLinkAttrib new $cono
  1419.         }
  1420.         default {
  1421.         ExportCono new $cono
  1422.         }
  1423.     }
  1424.     }
  1425.  
  1426.     foreach object [getSortedObjects] {
  1427.     $object generate
  1428.     }
  1429.  
  1430.     puts $outFile ""
  1431.     puts $outFile "\$diag save"
  1432.     cc_hack
  1433. }
  1434.  
  1435. #
  1436. #    ExportCCD
  1437. #
  1438. #    Generate import tool script for this class
  1439. #
  1440.  
  1441. Class ExportCCD : GCObject {
  1442.     attribute fileV
  1443.  
  1444.     constructor
  1445.  
  1446.     method generate
  1447. }
  1448.  
  1449. constructor ExportCCD {class object fileVersion} {
  1450.     set this [GCObject::constructor $class $object]
  1451.  
  1452.     $this fileV $fileVersion
  1453.  
  1454.     return $this
  1455. }
  1456.  
  1457. method ExportCCD::generate {this} {
  1458.     putNewDiagram CCD
  1459.  
  1460.     foreach node [[$this fileV] nodes] {
  1461.     ExportNode new $node
  1462.     }
  1463.  
  1464.     foreach conn [[$this fileV] connectors] {
  1465.     ExportConn new $conn
  1466.     }
  1467.  
  1468.     foreach object [getSortedObjects] {
  1469.     $object generate
  1470.     }
  1471.  
  1472.     puts $outFile ""
  1473.     puts $outFile "\$diag save"
  1474.     cc_hack
  1475. }
  1476.  
  1477. #
  1478. #    ExportCDM
  1479. #
  1480. #    Generate import tool script for this class
  1481. #
  1482.  
  1483. Class ExportCDM : GCObject {
  1484.     attribute fileV
  1485.  
  1486.     constructor
  1487.  
  1488.     method generate
  1489. }
  1490.  
  1491. constructor ExportCDM {class object fileVersion} {
  1492.     set this [GCObject::constructor $class $object]
  1493.  
  1494.     $this fileV $fileVersion
  1495.  
  1496.     return $this
  1497. }
  1498.  
  1499. method ExportCDM::generate {this} {
  1500.     putNewDiagram CDM
  1501.  
  1502.     #
  1503.     #    Workaround for problem in repository: rows are not sorted
  1504.     #
  1505.     #    foreach row [$fileV rows]
  1506.     #
  1507.     set firstRow [lindex [[$this fileV] rows] 0]
  1508.     set rowList ""
  1509.     if {$firstRow != ""} {
  1510.     while {![[$firstRow previous] isNil]} {
  1511.         set firstRow [$firstRow previous]
  1512.     }
  1513.  
  1514.     for {} {![$firstRow isNil]} {set firstRow [$firstRow next]} {
  1515.         lappend rowList $firstRow
  1516.     }
  1517.     }
  1518.  
  1519.     global verIn verOut
  1520.     if {$verIn == 4000 && $verOut >= 4001} {
  1521.     foreach row $rowList {
  1522.         [ExportCdmRow new $row] generate
  1523.     }
  1524.     } else {
  1525.     foreach row $rowList {
  1526.         [ExportRow new $row] generate
  1527.     }
  1528.     }
  1529.  
  1530.     puts $outFile ""
  1531.     puts $outFile "\$diag save"
  1532.     cc_hack
  1533. }
  1534.  
  1535. #
  1536. #    ExportCOD
  1537. #
  1538. #    Generate import tool script for this class
  1539. #
  1540.  
  1541. Class ExportCOD : GCObject {
  1542.     attribute fileV
  1543.  
  1544.     constructor
  1545.  
  1546.     method generate
  1547. }
  1548.  
  1549. constructor ExportCOD {class object fileVersion} {
  1550.     set this [GCObject::constructor $class $object]
  1551.  
  1552.     $this fileV $fileVersion
  1553.  
  1554.     return $this
  1555. }
  1556.  
  1557. method ExportCOD::generate {this} {
  1558.     set file [[$clientContext currentFile] file]
  1559.     set diagName [$file name]
  1560.     set qualifier [[$file item] qualifier]
  1561.     if {![$qualifier isNil] && [$qualifier isA Item]} {
  1562.     set diagName "[$qualifier name]:$diagName"
  1563.     } else {
  1564.     puts stderr "WARNING: COD filename '$diagName' is not qualified!"
  1565.     return
  1566.     }
  1567.  
  1568.     putNewDiagram COD $diagName
  1569.  
  1570.     foreach node [[$this fileV] nodes] {
  1571.     ExportNode new $node
  1572.     }
  1573.  
  1574.     foreach conn [[$this fileV] connectors] {
  1575.     ExportConn new $conn
  1576.     }
  1577.  
  1578.     foreach cono [[$this fileV] connectedNodes] {
  1579.     ExportCono new $cono
  1580.     }
  1581.  
  1582.     foreach object [getSortedObjects] {
  1583.     $object generate
  1584.     }
  1585.  
  1586.     puts $outFile ""
  1587.     puts $outFile "\$diag save"
  1588.     cc_hack
  1589. }
  1590.  
  1591. #
  1592. #    ExportDFD
  1593. #
  1594. #    Generate import tool script for this class
  1595. #
  1596.  
  1597. Class ExportDFD : GCObject {
  1598.     attribute fileV
  1599.  
  1600.     constructor
  1601.  
  1602.     method generate
  1603. }
  1604.  
  1605. constructor ExportDFD {class object fileVersion} {
  1606.     set this [GCObject::constructor $class $object]
  1607.  
  1608.     $this fileV $fileVersion
  1609.  
  1610.     return $this
  1611. }
  1612.  
  1613. method ExportDFD::generate {this} {
  1614.     putNewDiagram DFD
  1615.  
  1616.     foreach node [[$this fileV] nodes] {
  1617.     ExportNode new $node
  1618.     }
  1619.  
  1620.     foreach conn [[$this fileV] connectors] {
  1621.     ExportConn new $conn
  1622.     }
  1623.  
  1624.     foreach object [getSortedObjects] {
  1625.     $object generate
  1626.     }
  1627.  
  1628.     puts $outFile ""
  1629.     puts $outFile "\$diag save"
  1630.     cc_hack
  1631. }
  1632.  
  1633. #
  1634. #    ExportETD
  1635. #
  1636. #    Generate import tool script for this class
  1637. #
  1638.  
  1639. Class ExportETD : GCObject {
  1640.     attribute fileV
  1641.  
  1642.     constructor
  1643.  
  1644.     method generate
  1645. }
  1646.  
  1647. constructor ExportETD {class object fileVersion} {
  1648.     set this [GCObject::constructor $class $object]
  1649.  
  1650.     $this fileV $fileVersion
  1651.  
  1652.     return $this
  1653. }
  1654.  
  1655. method ExportETD::generate {this} {
  1656.     global verOut
  1657.  
  1658.     set file [[$clientContext currentFile] file]
  1659.     set diagName [$file name]
  1660.     if {$verOut >= 5100} {
  1661.     set qualifier [[$file item] qualifier]
  1662.     if {![$qualifier isNil] && [$qualifier isA Item]} {
  1663.         set diagName "[$qualifier name]:$diagName"
  1664.     } else {
  1665.         puts stderr "WARNING: ETD filename '$diagName' is not qualified!"
  1666.         return
  1667.     }
  1668.     }
  1669.  
  1670.     putNewDiagram ETD $diagName
  1671.  
  1672.     foreach node [[$this fileV] nodes] {
  1673.     switch [$node type] {
  1674.         etd_object      -
  1675.         etd_initiator {
  1676.         ExportEtdNode new $node
  1677.         }
  1678.         default {
  1679.         ExportNode new $node
  1680.         }
  1681.     }
  1682.     }
  1683.  
  1684.     foreach conn [[$this fileV] connectors] {
  1685.     ExportConn new $conn
  1686.     }
  1687.  
  1688.     global compCache
  1689.     foreach cono [[$this fileV] connectedNodes] {
  1690.     if {![info exists compCache($cono)]} {
  1691.         ExportCono new $cono
  1692.     }
  1693.     }
  1694.  
  1695.     foreach object [getSortedObjects] {
  1696.     $object generate
  1697.     }
  1698.  
  1699.     puts $outFile ""
  1700.     puts $outFile "\$diag save"
  1701.     cc_hack
  1702. }
  1703.  
  1704. #
  1705. #    ExportMGD
  1706. #
  1707. #    Generate import tool script for this class
  1708. #
  1709.  
  1710. Class ExportMGD : GCObject {
  1711.     attribute fileV
  1712.  
  1713.     constructor
  1714.  
  1715.     method generate
  1716. }
  1717.  
  1718. constructor ExportMGD {class object fileVersion} {
  1719.     set this [GCObject::constructor $class $object]
  1720.  
  1721.     $this fileV $fileVersion
  1722.  
  1723.     return $this
  1724. }
  1725.  
  1726. method ExportMGD::generate {this} {
  1727.     putNewDiagram MGD
  1728.  
  1729.     foreach node [[$this fileV] nodes] {
  1730.     case [$node type] {
  1731.         {message_gen} {
  1732.         ExportRakeNode new $node
  1733.         }
  1734.         default {
  1735.         ExportNode new $node
  1736.         }
  1737.     }
  1738.     }
  1739.  
  1740.     foreach conn [[$this fileV] connectors] {
  1741.     case [$conn type] {
  1742.         {message_gen_conn} {
  1743.         continue
  1744.         }
  1745.         default {
  1746.         ExportConn new $conn
  1747.         }
  1748.     }
  1749.     }
  1750.  
  1751.     foreach object [getSortedObjects] {
  1752.     $object generate
  1753.     }
  1754.  
  1755.     puts $outFile ""
  1756.     puts $outFile "\$diag save"
  1757.     cc_hack
  1758. }
  1759.  
  1760. #
  1761. #    ExportSTD
  1762. #
  1763. #    Generate import tool script for this class
  1764. #
  1765.  
  1766. Class ExportSTD : GCObject {
  1767.     attribute fileV
  1768.  
  1769.     constructor
  1770.  
  1771.     method generate
  1772. }
  1773.  
  1774. constructor ExportSTD {class object fileVersion} {
  1775.     set this [GCObject::constructor $class $object]
  1776.  
  1777.     $this fileV $fileVersion
  1778.  
  1779.     return $this
  1780. }
  1781.  
  1782. method ExportSTD::generate {this} {
  1783.     set file [[$clientContext currentFile] file]
  1784.     set diagName [$file name]
  1785.     set qualifier [[$file item] qualifier]
  1786.     if {![$qualifier isNil] && [$qualifier isA Item]} {
  1787.     set diagName "[$qualifier name]:$diagName"
  1788.     } else {
  1789.     puts stderr "ERROR: STD filename '$diagName' must be qualified."
  1790.     return
  1791.     }
  1792.  
  1793.     putNewDiagram STD $diagName
  1794.  
  1795.     foreach node [[$this fileV] nodes] {
  1796.     ExportNode new $node
  1797.     }
  1798.  
  1799.     foreach conn [[$this fileV] connectors] {
  1800.     ExportConn new $conn
  1801.     }
  1802.  
  1803.     foreach cono [[$this fileV] connectedNodes] {
  1804.     ExportStdCono new $cono
  1805.     }
  1806.  
  1807.     foreach object [getSortedObjects] {
  1808.     $object generate
  1809.     }
  1810.  
  1811.     puts $outFile ""
  1812.     puts $outFile "\$diag save"
  1813.     cc_hack
  1814. }
  1815.  
  1816. #
  1817. #    ExportUCD
  1818. #
  1819. #    Generate import tool script for this class
  1820. #
  1821.  
  1822. Class ExportUCD : GCObject {
  1823.     attribute fileV
  1824.  
  1825.     constructor
  1826.  
  1827.     method generate
  1828. }
  1829.  
  1830. constructor ExportUCD {class object fileVersion} {
  1831.     set this [GCObject::constructor $class $object]
  1832.  
  1833.     $this fileV $fileVersion
  1834.  
  1835.     return $this
  1836. }
  1837.  
  1838. method ExportUCD::generate {this} {
  1839.     putNewDiagram UCD
  1840.  
  1841.     foreach node [[$this fileV] nodes] {
  1842.     ExportNode new $node
  1843.     }
  1844.  
  1845.     foreach conn [[$this fileV] connectors] {
  1846.     ExportConn new $conn
  1847.     }
  1848.  
  1849.     foreach object [getSortedObjects] {
  1850.     $object generate
  1851.     }
  1852.  
  1853.     puts $outFile ""
  1854.     puts $outFile "\$diag save"
  1855.     cc_hack
  1856. }
  1857.  
  1858. #
  1859. #    End of diagram classes
  1860. #
  1861.  
  1862. global readOnlyLbl
  1863. #                    Boolean    0/1
  1864. set readOnlyLbl(cad_class:attributes)        1
  1865. set readOnlyLbl(cad_class:methods)        1
  1866. set readOnlyLbl(cad_container:attributes)    1
  1867. set readOnlyLbl(cad_container:methods)        1
  1868. set readOnlyLbl(link_attr_box:attributes)    1
  1869. set readOnlyLbl(state:editor_only)        1
  1870. set readOnlyLbl(transition:editor_only)        0
  1871. set readOnlyLbl(Segment:editor_only)        1
  1872.  
  1873. global clientContext
  1874.  
  1875. #
  1876. #    Main routine
  1877. #
  1878.  
  1879. proc exportDiagram {} {
  1880.     global exportNodeList;    set exportNodeList ""
  1881.     global exportConnList;    set exportConnList ""
  1882.     global exportConoList;    set exportConoList ""
  1883.     global compCache;        catch {unset compCache}
  1884.     global cdmCache;        catch {unset cdmCache}
  1885.  
  1886.     set fileV [$clientContext currentFile]
  1887.  
  1888.     if {[$fileV isNil]} {
  1889.     puts stderr "ERROR: unable to determine diagram from Client Context"
  1890.     return 1
  1891.     }
  1892.  
  1893.     case [[$fileV file] type] {
  1894.     {cad} {
  1895.         set diag [ExportCAD new $fileV]
  1896.         $diag generate
  1897.     }
  1898.     {ccd} {
  1899.         set diag [ExportCCD new $fileV]
  1900.         $diag generate
  1901.     }
  1902.     {cdm} {
  1903.         set diag [ExportCDM new $fileV]
  1904.         $diag generate
  1905.     }
  1906.     {cod} {
  1907.         set diag [ExportCOD new $fileV]
  1908.         $diag generate
  1909.     }
  1910.     {dfd} {
  1911.         set diag [ExportDFD new $fileV]
  1912.         $diag generate
  1913.     }
  1914.     {etd} {
  1915.         set diag [ExportETD new $fileV]
  1916.         $diag generate
  1917.     }
  1918.     {mgd} {
  1919.         set diag [ExportMGD new $fileV]
  1920.         $diag generate
  1921.     }
  1922.     {std} {
  1923.         set diag [ExportSTD new $fileV]
  1924.         $diag generate
  1925.     }
  1926.     {ucd} {
  1927.         set diag [ExportUCD new $fileV]
  1928.         $diag generate
  1929.     }
  1930.     default {
  1931.         puts stderr "ERROR: specified diagramtype is not supported"
  1932.         return 1
  1933.     }
  1934.     }
  1935. }
  1936.  
  1937. proc setOutFile {{fileName ""} {appendFile 0}} {
  1938.     global outFile
  1939.  
  1940.     if {$fileName == "" || $fileName == "stdout"} {
  1941.     set outFile stdout
  1942.     } else {
  1943.     if {$appendFile} {
  1944.         set mode "a"
  1945.     } else {
  1946.         set mode "w"
  1947.     }
  1948.     if [catch {set outFile [open $fileName $mode]} msg] {
  1949.         puts stderr "ERROR: $msg"
  1950.         puts stderr "MESSAGE: exporting to stdout"
  1951.         set outFile stdout
  1952.     }
  1953.     }
  1954.     return $outFile
  1955. }
  1956.  
  1957. proc putNewDiagram {diagType {diagName ""}} {
  1958.     global itDefaults
  1959.  
  1960.     if {$diagName == ""} {
  1961.         set diagName [[[$clientContext currentFile] file] name]
  1962.     }
  1963.     set sysName [[[$clientContext currentSystem] system] name]
  1964.     set phaseName [[[$clientContext currentPhase] phase] name]
  1965.     set phaseType [[[$clientContext currentPhase] phase] type]
  1966.     set confName [[[$clientContext currentConfig] config] name]
  1967.     set confVers [[$clientContext currentConfig] versionName]
  1968.     set projName [[$clientContext currentProject] name]
  1969.  
  1970.     switch -glob $itDefaults {
  1971.     s*    {set level 4}
  1972.     ph*    {set level 3}
  1973.     c*    {set level 2}
  1974.     pr*    {set level 1}
  1975.     default    {set level 0}
  1976.     }
  1977.     if {$level > 0} {set projName ""}
  1978.     if {$level > 1} {set confName "" ; set confVers ""}
  1979.     if {$level > 2} {set phaseName "" ; set phaseType ""}
  1980.     if {$level > 3} {set sysName ""}
  1981.  
  1982.     puts $outFile "set diag \[$diagType new $diagName \"$sysName\" \"$phaseName\" \"$phaseType\" \"$confName\" \"$confVers\" \"$projName\" [fileHasScopePhase $clientContext]\]"
  1983. }
  1984.  
  1985. proc putHeader {verIn verOut etArgs} {
  1986.     set verLabel [versionInfo versionLabel]
  1987.     set tmp [string trim $SCCS_W "\n%"]
  1988.     if {$tmp != "W"} {
  1989.     regsub "^@.#." $tmp {} tmp
  1990.     set idLabel $tmp
  1991.     } else {
  1992.     set idLabel "et.tcl $verLabel\t[versionInfo dateLabel]"
  1993.     }
  1994.     puts $outFile "\n# Generator: $idLabel"
  1995.     puts $outFile "# Argument(s): $etArgs"
  1996.     puts $outFile "# Interpreter to use: Otsh $verLabel"
  1997.     puts $outFile "#"
  1998.     puts $outFile "OTShRegister::importTool"
  1999.     puts $outFile ""
  2000. }
  2001.  
  2002. proc downLevelToFile {fileV_id} {
  2003.     if {[$clientContext currentLevel] == "File"} {
  2004.     $clientContext upLevel
  2005.     }
  2006.     switch -glob $fileV_id {
  2007.     Graph*    {set fileV [Graph new $fileV_id]}
  2008.     default    {set fileV [Matrix new $fileV_id]}
  2009.     }
  2010.     $clientContext downLevelId $fileV
  2011. }
  2012.  
  2013. proc exportTool {{argv {}}} {
  2014.     regsub {/.*} [versionInfo maintVersion] {} maintVersion
  2015.     set maintVersion [expr $maintVersion + 0]
  2016.     if {[expr $maintVersion < 10]} {set maintVersion "0$maintVersion"}
  2017.     set version "[versionInfo majorVersion][versionInfo minorVersion]$maintVersion"
  2018.  
  2019.     global explicitCreate;    set explicitCreate 0
  2020.     global globalView;        set globalView 0
  2021.     global verIn;        set verIn $version
  2022.     global verOut;        set verOut $version
  2023.     global lblConv;        catch {unset lblConv}
  2024.     global itDefaults;        set itDefaults "none"
  2025.  
  2026.     set fileName ""
  2027.     set appendFile 0
  2028.  
  2029.     set etArgs $argv
  2030.     while {![lempty $argv]} {
  2031.     set arg [lvarpop argv]
  2032.     switch -glob -- $arg {
  2033.         -a*        { set fileName [string range $arg 2 end]
  2034.               set appendFile 1 }
  2035.         -x*        -
  2036.         -e*        { set explicitCreate 1 }
  2037.         -f*        { downLevelToFile [string range $arg 2 end] }
  2038.         -g*        { set globalView 1 }
  2039.         -i*        { set explicitCreate 0 }
  2040.         -l*        { set globalView 0 }
  2041.         -o*        { set fileName [string range $arg 2 end]
  2042.               set appendFile 0 }
  2043.         -d*        { set itDefaults [string range $arg 2 end] }
  2044.         -vi*    { set verIn [string range $arg 3 end] }
  2045.         -vo*    { set verOut [string range $arg 3 end] }
  2046.         -*        { puts stderr "WARNING: '$arg': illegal option" }
  2047.         *        { puts stderr "WARNING: '$arg': illegal argument" }
  2048.     }
  2049.     }
  2050.  
  2051.     if {$verOut < $verIn} {
  2052.     puts stderr "ERROR: output version number ($verOut) must be greater then input version number ($verIn)"
  2053.     return 1
  2054.     }
  2055.     if {$verIn == 4000 && $verOut >= 4001} {
  2056.     initLabelConv
  2057.     }
  2058.  
  2059.     set outFile [setOutFile $fileName $appendFile]
  2060.  
  2061.     putHeader $verIn $verOut $etArgs
  2062.  
  2063.     if [catch {exportDiagram}] {
  2064.     if {$outFile != "stdout"} {close $outFile}
  2065.     puts stderr "ERROR: $errorInfo"
  2066.     return 2
  2067.     }
  2068.  
  2069.     if {$outFile != "stdout"} {
  2070.     close $outFile
  2071.     }
  2072.     return 0
  2073. }
  2074.  
  2075.  
  2076.  
  2077. global et_dont_run
  2078. if [catch {set et_dont_run}] {
  2079.     exportTool $argv
  2080. }
  2081.