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