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