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