home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / ssysvdbobj.tcl < prev    next >
Text File  |  1997-05-30  |  11KB  |  404 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1996
  4. #
  5. #      File:           @(#)ssysvdbobj.tcl    /main/hindenburg/6
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)ssysvdbobj.tcl    /main/hindenburg/6   30 May 1997 Copyright 1996 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12. require "svdgvuiobj.tcl"
  13. require "wmt_util.tcl"
  14. # End user added include file section
  15.  
  16. require "sysvdbobj.tcl"
  17.  
  18. Class SSysVDbObj : {SysVDbObj} {
  19.     method destructor
  20.     constructor
  21.     method promoter
  22.     method addExternalLinks
  23.     method addFileVersion
  24.     method addGroupVersion
  25.     method allowsDrop
  26.     method canBeDragged
  27.     method compareWithPrevPhase
  28.     method importFiles
  29.     method importFromPrevPhase
  30.     method prevPhaseExists
  31.     method printObjects
  32.     method reverseEngineer
  33.     method savedGroupVersions
  34.     method snapshotObjects
  35.     attribute prevPhaseV
  36.     attribute savedGroupVersionSet
  37. }
  38.  
  39. method SSysVDbObj::destructor {this} {
  40.     # Start destructor user section
  41.  
  42.     [$this savedGroupVersionSet] delete
  43.  
  44.     # End destructor user section
  45.     $this SysVDbObj::destructor
  46. }
  47.  
  48. constructor SSysVDbObj {class this name} {
  49.     set this [SysVDbObj::constructor $class $this $name]
  50.     return $this
  51. }
  52.  
  53. method SSysVDbObj::promoter {this} {
  54.     $this SysVDbObj::promoter
  55.  
  56.     set savedGroupVersionSet $this.${SvdGVUiObj::uiClass}:0
  57.     if {! [isCommand $savedGroupVersionSet]} {
  58.     SvdGVUiObj new $savedGroupVersionSet -parent $this
  59.     }
  60.     $this savedGroupVersionSet $savedGroupVersionSet
  61. }
  62.  
  63. method SSysVDbObj::addExternalLinks {this} {
  64.     set box $wmttoolObj.newExternalL
  65.     if {! [isCommand $box]} {
  66.     ClassMaker::extend FileChooser NewExternalLFileChooser dbObj
  67.     NewExternalLFileChooser new $box \
  68.         -title "New External Link(s)" \
  69.         -selectionPolicy EXTENDED \
  70.         -directory [pwd] \
  71.         -filter "*.*" \
  72.         -okPressed {
  73.         set script ""
  74.         set invisibleTypes ""
  75.         set currentSpec [[$wmttoolObj infoView] currentSpec]
  76.         if [isCommand $currentSpec] {
  77.             set visibleTypes [$currentSpec objectTypes]
  78.         } else {
  79.             set visibleTypes ""
  80.         }
  81.         foreach external [%this selectedSet] {
  82.             set type [path_name type $external]
  83.             set name [path_name base $external]
  84.             if {(! [lempty $visibleTypes]) &&
  85.             [lsearch -exact $visibleTypes "$type"] == -1} {
  86.             append invisibleTypes "\n$external"
  87.             }
  88.             if {"$script" != ""} {
  89.             append script " ;"
  90.             }
  91.             append script \
  92.             " [%this dbObj] createExternalLink \
  93.                 [list $name] [list $type] [list $external]"
  94.         }
  95.         if {"$script" != ""} {
  96.             $wmttoolObj startCommand tcl \
  97.             "$script" "" \
  98.             "Creating external file link(s)..." \
  99.             {1 0} 1
  100.         }
  101.         if {"$invisibleTypes" != ""} {
  102.             set box $wmttoolObj.newExternalLWarning
  103.             set message \
  104.             "The following external file links are not visible\n\
  105.              within the current view:\n\
  106.              $invisibleTypes"
  107.             WarningDialog new $box \
  108.             -title "New External Link(s) Warning" \
  109.             -message $message \
  110.             -helpPressed {.main helpOnName newExternalLWarning} \
  111.             -okPressed "$box delete"
  112.             $box popUp
  113.         }
  114.         }
  115.     $box delHelpButton
  116.     }
  117.     $box dbObj $this
  118.     $box popUp
  119. }
  120.  
  121. method SSysVDbObj::addFileVersion {this type} {
  122.     require "newdiagram.tcl"
  123.  
  124.     set box "$wmttoolObj.new[string toupper $type]"
  125.     if {! [isCommand $box]} {
  126.     NewDiagramDlg new $box -type $type
  127.     }
  128.     $box dbObj $this
  129.     $box popUp
  130. }
  131.  
  132. method SSysVDbObj::addGroupVersion {this} {
  133.     require "newgroupvd.tcl"
  134.  
  135.     set box $wmttoolObj.newGroupV
  136.     if {! [isCommand $box]} {
  137.     NewGroupVDlg new $box
  138.     }
  139.     $box dbObj $this
  140.     $box popUp
  141. }
  142.  
  143. method SSysVDbObj::allowsDrop {this uiClass} {
  144.     case "$uiClass" in {
  145.     {CorporateGroupVersion Graph GroupVersion Matrix} {
  146.         return 1
  147.     }
  148.     {default} {
  149.         return 0
  150.     }
  151.     }
  152. }
  153.  
  154. proc SSysVDbObj::associations {} {
  155.     return {\
  156.     localFileVersions groupVersions customFileVersionSet \
  157.     savedGroupVersionSet workItemSet controlledListSet accessRuleSet\
  158.     }
  159. }
  160.  
  161. method SSysVDbObj::canBeDragged {this} {
  162.     return 1
  163. }
  164.  
  165. proc SSysVDbObj::childTypes {assoc} {
  166.     if {[lsearch -exact "[SSysVDbObj::associations]" "$assoc"] == -1} {
  167.     return ""
  168.     }
  169.     set childTypes [BrowserProcs::childTypes $assoc]
  170.     case "$childTypes" in {
  171.     {LocalFileVersion} {
  172.         return "${BrowserProcs::diagramFileTypes}"
  173.     }
  174.     {default} {
  175.         return [SysVDbObj::childTypes "$assoc"]
  176.     }
  177.     }
  178. }
  179.  
  180. method SSysVDbObj::compareWithPrevPhase {this} {
  181.     require "comparepha.tcl"
  182.     ComparePhaseDlg new $wmttoolObj.compareWithPrevPhase \
  183.     -dbObj $this \
  184.     -title "Compare With Previous Phase" \
  185.     -helpPressed {.main helpOnName compareWithPrevPhase}
  186.     $wmttoolObj.compareWithPrevPhase popUp
  187. }
  188.  
  189. proc SSysVDbObj::controlledLists {} {
  190.     return [concat \
  191.     [SysVDbObj::controlledLists] \
  192.     {"[$this corporateGroupVersionLinkList]"
  193.      "[$this externalLinkList]"
  194.      "[[$this system] groupList]"
  195.      "[$this groupVersionLinkList]"} \
  196.     ]
  197. }
  198.  
  199. method SSysVDbObj::importFiles {this fileList overwriteFlag} {
  200.     set args "-f impfiles.tcl"
  201.     if {"$overwriteFlag" != "" || (! [lempty $fileList])} {
  202.     append args " --"
  203.     if {"$overwriteFlag" != ""} {
  204.         append args " $overwriteFlag"
  205.     }
  206.     if {! [lempty $fileList]} {
  207.         append args " $fileList"
  208.     }
  209.     }
  210.     set script "[quoteIf [m4_path_name bin otsh$EXE_EXT]] $args"
  211.     $wmttoolObj startCommand mtool \
  212.     "$script" "" "Starting 'Import Files'" {1 0} 0
  213. }
  214.  
  215. method SSysVDbObj::importFromPrevPhase {this mode} {
  216.     set fileList ""
  217.     case "$mode" in {
  218.     {selected} {
  219.         foreach obj [$wmttoolObj selectedObjSet] {
  220.         if [$obj isA SystemFileReference] {
  221.             set fileV [$obj getInfo "File Version"]
  222.             if {"$fileV" != ""} {
  223.             lappend fileList [[$fileV file] identity]
  224.             }
  225.         } elseif [$obj isA FileVersion] {
  226.             lappend fileList [[$obj file] identity]
  227.         }
  228.         }
  229.     }
  230.     }
  231.  
  232.     ClassMaker::extend YesNoWarningDialog OverwritePropertiesDialog \
  233.     {dbObj fileList}
  234.     set box $wmttoolObj.overwriteProperties
  235.     OverwritePropertiesDialog new $box \
  236.     -title "Overwrite Properties" \
  237.     -message "Should properties of existing items be overwritten ?" \
  238.     -dbObj $this \
  239.     -fileList $fileList \
  240.     -yesPressed {
  241.         [%this dbObj] importFiles "[%this fileList]" "-overwrite"
  242.         %this delete
  243.     } \
  244.     -noPressed {
  245.         [%this dbObj] importFiles "[%this fileList]" ""
  246.         %this delete
  247.     } \
  248.     -cancelPressed {%this delete} \
  249.     -helpPressed {.main helpOnName overwriteProperties}
  250.     $box popUp
  251. }
  252.  
  253. proc SSysVDbObj::infoProperties {} {
  254.     return [SysVDbObj::infoProperties]
  255. }
  256.  
  257. method SSysVDbObj::prevPhaseExists {this} {
  258.     set confV [$this getParent ConfigVersion]
  259.     set phaseV [$this getParent PhaseVersion]
  260.     set prevPhaseV [$phaseV previous $confV]
  261.     if {! [$prevPhaseV isA PhaseVersion]} {
  262.     return 0
  263.     }
  264.  
  265.     $this prevPhaseV $prevPhaseV
  266.     return 1
  267. }
  268.  
  269. method SSysVDbObj::printObjects {this} {
  270.     set asciiFiles ""
  271.     set topostObjects ""
  272.     set errorStack ""
  273.     set confV [$this getParent ConfigVersion]
  274.     foreach obj [$wmttoolObj selectedObjSet] {
  275.     if [$obj isA ExternalLink] {
  276.         lappend asciiFiles [$obj path]
  277.     } elseif [$obj isA SystemFileReference] {
  278.         set fileV [$obj getInfo "File Version"]
  279.         if [$fileV isA Graph] {
  280.         set sysV [$obj referredSystemVersion]
  281.         if [$sysV isNil] {
  282.             if {"$errorStack" == ""} {
  283.             append errorStack "\n"
  284.             }
  285.             append errorStack "Could not print \
  286.              [$obj getInfo Type] '[$obj getInfo Name]':\n    \
  287.              System '[[$obj referredSystem] name]' is not \
  288.              selected within the current PhaseVersion"
  289.         } else {
  290.             require "print.tcl"
  291.             eval Print::printDiagrams \
  292.             -configVersion $confV \
  293.             -systemVersion $sysV \
  294.             $fileV
  295.         }
  296.         } elseif [$fileV isA ExternalFileVersion] {
  297.         $fileV synchWithFileSystem
  298.         lappend asciiFiles [$fileV path]
  299.         }
  300.     } elseif [$obj isA Graph] {
  301.         lappend topostObjects $obj
  302.     } elseif [$obj isA ExternalFileVersion] {
  303.         $obj synchWithFileSystem
  304.         lappend asciiFiles [$obj path]
  305.     }
  306.     }
  307.     BrowserProcs::printObjects $asciiFiles "" $topostObjects
  308.     if {"$errorStack" != ""} {
  309.     wmtkerror $errorStack
  310.     }
  311. }
  312.  
  313. method SSysVDbObj::reverseEngineer {this lang language hdrFileType} {
  314.     # e.g.: lang = "cpp", language = "C++", hdrFileType = "h++"
  315.     set typeSpec [getObjectSpec [$wmttoolObj objectHdlr] \
  316.                 ExternalFileVersion $hdrFileType]
  317.     set hdrFileExt $hdrFileType
  318.     if {"$typeSpec" != ""} {
  319.     set hdrFileExt [$typeSpec fsExtension]
  320.     }
  321.     set filter *
  322.     if {"$hdrFileExt" != ""} {
  323.     append filter .$hdrFileExt
  324.     }
  325.     set box $wmttoolObj.reverseEngineer[cap $lang]Files
  326.     if {! [isCommand $box]} {
  327.     ClassMaker::extend FileChooser RevEng[cap $lang]FileChooser {dbObj lang}
  328.     RevEng[cap $lang]FileChooser new $box \
  329.         -title "Reverse Engineer $language" \
  330.         -selectionPolicy EXTENDED \
  331.         -directory [pwd] \
  332.         -filter $filter \
  333.         -okPressed {
  334.         set clang [cap [%this lang]]
  335.         set box $wmttoolObj.reverseEngineer$clang
  336.         require [string range reveng[%this lang]dlg 0 9].tcl
  337.         if {! [isCommand $box]} {
  338.             RevEng${clang}Dlg new $box \
  339.             -helpPressed ".main helpOnName reverseEngineer$clang"
  340.         }
  341.         $box config \
  342.             -dbObj [%this dbObj] \
  343.             -headerFiles [%this selectedSet]
  344.         $box popUp
  345.         }
  346.     $box delHelpButton
  347.     }
  348.     $box dbObj $this
  349.     $box lang $lang
  350.     $box popUp
  351. }
  352.  
  353. method SSysVDbObj::savedGroupVersions {this} {
  354.     set savedGroupVersions ""
  355.     foreach savedGroup [[$this system] savedGroups] {
  356.     set savedGroupVersions \
  357.         [concat $savedGroupVersions [$savedGroup savedGroupVersions]]
  358.     }
  359.     return $savedGroupVersions
  360. }
  361.  
  362. method SSysVDbObj::snapshotObjects {this} {
  363.     set objList [$wmttoolObj selectedObjSet]
  364.     if [lempty $objList] {
  365.     return
  366.     }
  367.     foreach obj $objList {
  368.     if {! [$obj isA GroupVersion]} {
  369.         return
  370.     }
  371.     }
  372.  
  373.     if {! [isCommand $wmttoolObj.snapshotVersion]} {
  374.     ClassMaker::extend EntryDialog SnapshotVEntryDialog {dbObj objList}
  375.     SnapshotVEntryDialog new $wmttoolObj.snapshotVersion \
  376.         -modal yes \
  377.         -title "Snapshot" \
  378.         -message "Comments:" \
  379.         -helpPressed {.main helpOnName snapshotVersion} \
  380.         -okPressed {
  381.         set comments [%this entry]
  382.         set dbObj [%this dbObj]
  383.         set objList [%this objList]
  384.         set script ""
  385.         set confV [$dbObj getParent ConfigVersion]
  386.         foreach obj $objList {
  387.             if {"$script" != ""} {
  388.             append script " ;"
  389.             }
  390.             append script \
  391.             " $obj snapshot $dbObj $confV [list $comments]"
  392.         }
  393.         $wmttoolObj startCommand tcl "$script" "" "" {1 0} 1
  394.         }
  395.     }
  396.     $wmttoolObj.snapshotVersion config \
  397.     -dbObj $this \
  398.     -objList $objList
  399.     $wmttoolObj.snapshotVersion popUp
  400. }
  401.  
  402. # Do not delete this line -- regeneration end marker
  403.  
  404.