home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / confvdbobj.tcl < prev    next >
Text File  |  1997-11-26  |  12KB  |  435 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)confvdbobj.tcl    /main/titanic/12
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)confvdbobj.tcl    /main/titanic/12   26 Nov 1997 Copyright 1997 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12. # End user added include file section
  13.  
  14. require "browsdbobj.tcl"
  15. require "versionobj.tcl"
  16.  
  17. Class ConfVDbObj : {BrowsDbObj VersionObj ConfigVersion} {
  18.     method destructor
  19.     constructor
  20.     method promoter
  21.     method addPhaseVersions
  22.     method changeLinks
  23.     method copyVersion
  24.     method deselectObjects
  25.     method makeUpToDate
  26.     method name
  27.     method newObjects
  28.     method phaseVersions
  29.     method removeObjects
  30.     method removeVersion
  31.     method selectObject
  32.     method versionInLabel
  33.     method canBeDragged
  34. }
  35.  
  36. method ConfVDbObj::destructor {this} {
  37.     # Start destructor user section
  38.     # End destructor user section
  39.     $this BrowsDbObj::destructor
  40.     $this VersionObj::destructor
  41. }
  42.  
  43. constructor ConfVDbObj {class this name} {
  44.     set this [ConfigVersion::constructor $class $this $name]
  45.     set this [BrowsDbObj::constructor $class $this $name]
  46.     set this [VersionObj::constructor $class $this $name]
  47.     return $this
  48. }
  49.  
  50. selfPromoter ConfigVersion {this} {
  51.     ConfVDbObj promote $this
  52. }
  53.  
  54. method ConfVDbObj::promoter {this} {
  55.     $this BrowsDbObj::promoter
  56.  
  57.     set customFileVersionSet $this.${CustFVUiObj::uiClass}:0
  58.     if {! [isCommand $customFileVersionSet]} {
  59.     CustFVUiObj new $customFileVersionSet -parent $this
  60.     }
  61.     $this customFileVersionSet $customFileVersionSet
  62.  
  63.     module_promoter ConfVDbObj $this
  64. }
  65.  
  66. method ConfVDbObj::addPhaseVersions {this} {
  67.     set proj [$this project]
  68.     set phaseList ""
  69.     foreach phase ${BrowserProcs::phases} {
  70.     set phaseName [lindex $phase 0]
  71.     set phaseType [lindex $phase 1]
  72.     if {[[$proj findPhase "$phaseName" "$phaseType"] isNil] ||
  73.         [[$this findPhaseVersion "$phaseName" "$phaseType"] isNil]} {
  74.         lappend phaseList "$phaseName"
  75.     }
  76.     }
  77.  
  78.     if [lempty $phaseList] {
  79.     wmtkinfo "A PhaseVersion already exists for each Phase"
  80.     return
  81.     }
  82.  
  83.     set objectSpecList ""
  84.     foreach phaseName $phaseList {
  85.     set id [lsearch -regexp \
  86.         ${BrowserProcs::phases} \
  87.         [format "%s%s" $phaseName {[ |\t|\n\]*}] \
  88.     ]
  89.     set phaseType [lindex [lindex ${BrowserProcs::phases} $id] 1]
  90.     set typeSpec [getObjectSpec [$wmttoolObj objectHdlr] \
  91.         PhaseVersion $phaseType \
  92.     ]
  93.     if {"$typeSpec" != ""} {
  94.         set icon [$typeSpec smallIcon]
  95.     } else {
  96.         set icon ""
  97.     }
  98.     lappend objectSpecList [list $icon $phaseName]
  99.     }
  100.  
  101.     require "browsviewd.tcl"
  102.     set box $wmttoolObj.newPhaseV
  103.     ClassMaker::extend BrowsViewDialog NewPhaseVBrowsViewDialog dbObj
  104.     NewPhaseVBrowsViewDialog new $box \
  105.     -title "New Phase Version" \
  106.     -headerSpecList {{Name 20 ascii {none}}} \
  107.     -objectSpecList $objectSpecList \
  108.     -dbObj $this \
  109.     -cancelPressed {%this delete} \
  110.     -okPressed {
  111.         set proj [[%this dbObj] project]
  112.         foreach object [[%this view] selectedSet] {
  113.         set phaseName [$object label]
  114.  
  115.         # get phase type
  116.         foreach phase ${BrowserProcs::phases} {
  117.             if {"[lindex $phase 0]" == "$phaseName"} {
  118.             set phaseType [lindex $phase 1]
  119.             break
  120.             }
  121.         }
  122.  
  123.         # find predecessor phase
  124.         set predPhase ""
  125.         set predName $phaseName
  126.         set predType $phaseType
  127.         while {! ("$predPhase" != "" && [$predPhase isA Phase])} {
  128.             set id 0
  129.             set found 0
  130.             foreach phase ${BrowserProcs::phases} {
  131.             if {"[lindex $phase 0]" == "$predName" &&
  132.                 "[lindex $phase 1]" == "$predType"} {
  133.                 set found 1
  134.                 break
  135.             }
  136.             incr id 1
  137.             }
  138.             if {(! $found) || ($id == 0)} {
  139.             set predName ""
  140.             break
  141.             }
  142.             set predPhase \
  143.             [lindex ${BrowserProcs::phases} [expr $id - 1]]
  144.             set predName [lindex $predPhase 0]
  145.             set predType [lindex $predPhase 1]
  146.             set predPhase [$proj findPhase "$predName" "$predType"]
  147.         }
  148.  
  149.         # find successor phase
  150.         set succPhase ""
  151.         set succName $phaseName
  152.         set succType $phaseType
  153.         set len [llength ${BrowserProcs::phases}]
  154.         while {! ("$succPhase" != "" && [$succPhase isA Phase])} {
  155.             set id 0
  156.             set found 0
  157.             foreach phase ${BrowserProcs::phases} {
  158.             if {"[lindex $phase 0]" == "$succName" &&
  159.                 "[lindex $phase 1]" == "$succType"} {
  160.                 set found 1
  161.                 break
  162.             }
  163.             incr id 1
  164.             }
  165.             if {(! $found) || ($id >= [expr $len - 1])} {
  166.             set succName ""
  167.             break
  168.             }
  169.             set succPhase \
  170.             [lindex ${BrowserProcs::phases} [expr $id + 1]]
  171.             set succName [lindex $succPhase 0]
  172.             set succType [lindex $succPhase 1]
  173.             set succPhase [$proj findPhase "$succName" "$succType"]
  174.         }
  175.  
  176.         if {"$predPhase" != "" && [$predPhase isA Phase]} {
  177.             set script "[%this dbObj] createPhaseVersionBehind \
  178.             [list $phaseName] [list $phaseType] $predPhase"
  179.         } elseif {"$succPhase" != "" && [$succPhase isA Phase]} {
  180.             set script "[%this dbObj] createPhaseVersionBefore \
  181.             [list $phaseName] [list $phaseType] $succPhase"
  182.         } else {
  183.             set lastPhase [$proj lastPhase]
  184.             if [$lastPhase isNil] {
  185.             set createBehind 0
  186.             } else {
  187.             set createBehind 1
  188.             foreach phase ${BrowserProcs::phases} {
  189.                 if {"[$lastPhase name]" == "[lindex $phase 0]" &&
  190.                 "[$lastPhase type]" == "[lindex $phase 1]"} {
  191.                 set createBehind 0
  192.                 break
  193.                 }
  194.             }
  195.             }
  196.             if $createBehind {
  197.             set script "[%this dbObj] createPhaseVersionBehind \
  198.                 [list $phaseName] [list $phaseType] $lastPhase"
  199.             } else {
  200.             set script "[%this dbObj] createPhaseVersion \
  201.                 [list $phaseName] [list $phaseType]"
  202.             }
  203.         }
  204.         $wmttoolObj startCommand tcl \
  205.             "$script" "" \
  206.             "Creating phase version '$phaseName'..." \
  207.             {1 0} 1
  208.         }
  209.         %this delete
  210.     }
  211.     $box popUp
  212. }
  213.  
  214. proc ConfVDbObj::associations {} {
  215.     return {phaseVersions customFileVersionSet}
  216. }
  217.  
  218. method ConfVDbObj::changeLinks {this} {
  219.     ClassMaker::extend TemplateDialog ChangeLinksTemplateDialog dbObj
  220.     ChangeLinksTemplateDialog new $wmttoolObj.changeLink \
  221.     -modal yes \
  222.     -title "Change Link(s)" \
  223.     -dbObj $this \
  224.     -helpPressed {.main helpOnName changeLink} \
  225.     -cancelPressed {%this delete} \
  226.     -okPressed {
  227.         set status [%this.top.status selected]
  228.         set script ""
  229.         foreach obj [$wmttoolObj selectedObjSet] {
  230.         set found 0
  231.         foreach link [$obj configVersionLinks] {
  232.             if {"[$link configVersion]" == "[%this dbObj]"} {
  233.             set found 1
  234.             break
  235.             }
  236.         }
  237.         if {! $found} {
  238.             wmtkerror "link to [$obj getInfo Type] \
  239.                 '[$obj getInfo Name]' not found"
  240.             continue
  241.         }
  242.         if {"$script" != ""} {
  243.             append script " ;"
  244.         }
  245.         append script " $link status $status"
  246.         }
  247.         if {"$script" != ""} {
  248.         $wmttoolObj startCommand tcl "$script" "" "" {1 0} 1
  249.         }
  250.         %this delete
  251.     }
  252.     interface DlgColumn $wmttoolObj.changeLink.top {
  253.     Label messageLab {
  254.         text "Link Status:"
  255.     }
  256.     VerRadioGroup status {
  257.         entrySet {fixed dynamicFrozen}
  258.     }
  259.     }
  260.     if {[llength [$wmttoolObj selectedObjSet]] == 1} {
  261.     $wmttoolObj.changeLink.top.status selected \
  262.         [[lindex [$wmttoolObj selectedObjSet] 0] getInfo Link]
  263.     } else {
  264.     $wmttoolObj.changeLink.top.status selected fixed
  265.     }
  266.     $wmttoolObj.changeLink popUp
  267. }
  268.  
  269. proc ConfVDbObj::childTypes {assoc} {
  270.     if {[lsearch -exact "[ConfVDbObj::associations]" "$assoc"] == -1} {
  271.     return ""
  272.     }
  273.     set childTypes [BrowserProcs::childTypes $assoc]
  274.     case "$childTypes" in {
  275.     {PhaseVersion} {
  276.         set childTypes ""
  277.         foreach phase ${BrowserProcs::phases} {
  278.         set phaseType [lindex $phase 1]
  279.         if {[lsearch -exact $childTypes "$phaseType"] != -1} continue
  280.         lappend childTypes "$phaseType"
  281.         }
  282.         return "$childTypes"
  283.     }
  284.     {default} {
  285.         return "$childTypes"
  286.     }
  287.     }
  288. }
  289.  
  290. proc ConfVDbObj::controlledLists {} {
  291.     return {
  292.     "[[$this ConfigVersion::config] configVersionList]"
  293.     "[[$this ConfigVersion::config] customFileList]"
  294.     "[$this customFileVersionLinkList]"
  295.     "[$this phaseVersionLinkList]"
  296.     }
  297. }
  298.  
  299. method ConfVDbObj::copyVersion {this} {
  300.     set versionList ""
  301.     foreach version [[$this project] configVersions] {
  302.     if {"$version" == "$this"} continue
  303.     lappend versionList [list \
  304.         $version "[[$version ConfigVersion::config] name]"
  305.     ]
  306.     }
  307.     BrowserProcs::copyVersion $this $versionList
  308. }
  309.  
  310. method ConfVDbObj::deselectObjects {this} {
  311.     set script ""
  312.     foreach obj [$wmttoolObj selectedObjSet] {
  313.     if {"$script" != ""} {
  314.         append script " ;"
  315.     }
  316.     append script " $this deselectVersion $obj"
  317.     }
  318.     $wmttoolObj startCommand tcl "$script" "" "" {1 0} 1
  319. }
  320.  
  321. proc ConfVDbObj::infoProperties {} {
  322.     return [concat \
  323.     [BrowserProcs::infoProperties] \
  324.     {Status Version Comments Created Updated Frozen "Controlled Actions"
  325.      "Created By" "Updated By"} \
  326.     ]
  327. }
  328.  
  329. method ConfVDbObj::makeUpToDate {this} {
  330.     $this VersionObj::makeUpToDate
  331. }
  332.  
  333. method ConfVDbObj::name {this} {
  334.     return "[[$this ConfigVersion::config] name]"
  335. }
  336.  
  337. method ConfVDbObj::newObjects {this} {
  338.     set script ""
  339.     foreach obj [$wmttoolObj selectedObjSet] {
  340.     if {"$script" != ""} {
  341.         append script " ;"
  342.     }
  343.     append script " $this derive -phaseVersion $obj"
  344.     }
  345.     $wmttoolObj startCommand tcl "$script" "" "" {1 0} 1
  346. }
  347.  
  348. method ConfVDbObj::phaseVersions {this} {
  349.     set phaseVersions ""
  350.     foreach link [$this phaseVersionLinks] {
  351.     set phaseV [$link phaseVersion]
  352.     $phaseV setInfo ConfigPhaseLink $link
  353.     lappend phaseVersions $phaseV
  354.     }
  355.     return $phaseVersions
  356. }
  357.  
  358. method ConfVDbObj::removeObjects {this} {
  359.     set box $wmttoolObj.removeWarning
  360.     ClassMaker::extend YesNoWarningDialog RemoveObjectsWarningDialog dbObj
  361.     RemoveObjectsWarningDialog new $box \
  362.     -title "Confirm Phase Delete" \
  363.     -message [BrowserProcs::removeMessage] \
  364.     -dbObj $this \
  365.     -noPressed {%this delete} \
  366.     -yesPressed {
  367.         set dbObj [%this dbObj]
  368.         set script ""
  369.         foreach obj [$wmttoolObj selectedObjSet] {
  370.         if {"$script" != ""} {
  371.             append script " ;"
  372.         }
  373.         append script " $dbObj removeObject $obj"
  374.         }
  375.         $wmttoolObj startCommand tcl "$script" "" "" {1 0} 1
  376.         %this delete
  377.     }
  378.     $box delCancelButton
  379.     $box popUp
  380. }
  381.  
  382. method ConfVDbObj::removeVersion {this} {
  383.     BrowserProcs::removeVersion \
  384.     "[$this getParent Project]" "[$this ConfigVersion::config]" "$this"
  385. }
  386.  
  387. method ConfVDbObj::selectObject {this mode} {
  388.     busy {
  389.     set versionList ""
  390.     foreach phaseV [$this phaseVersions] {
  391.         set workingList([$phaseV phase]) $phaseV
  392.     }
  393.     case "$mode" in {
  394.         {new} {
  395.         set phaseList ""
  396.         foreach phase [[$this project] phases] {
  397.             if [info exists workingList($phase)] continue
  398.             lappend phaseList $phase
  399.         }
  400.         }
  401.         {default} {
  402.         set phaseList ""
  403.         foreach obj [$wmttoolObj selectedObjSet] {
  404.             lappend phaseList [$obj phase]
  405.         }
  406.         }
  407.     }
  408.     foreach phase $phaseList {
  409.         set phaseName [$phase name]
  410.         if [info exists workingList($phase)] {
  411.         set working $workingList($phase)
  412.         } else {
  413.         set working [ORB::nil]
  414.         }
  415.         foreach version [$phase phaseVersions] {
  416.         if [$version isSame $working] continue
  417.         if {"[$version status]" == "working"} continue
  418.         lappend versionList [list $version "$phaseName"]
  419.         }
  420.     }
  421.     BrowserProcs::selectObject $this $versionList $mode
  422.     }
  423. }
  424.  
  425. method ConfVDbObj::versionInLabel {this} {
  426.     return 1
  427. }
  428.  
  429. method ConfVDbObj::canBeDragged {this} {
  430.     return 1
  431. }
  432.  
  433. # Do not delete this line -- regeneration end marker
  434.  
  435.