home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / groupvdbob.tcl < prev    next >
Text File  |  1996-11-07  |  9KB  |  326 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cadre Technologies Inc.    1996
  4. #
  5. #      File:           @(#)groupvdbob.tcl    /main/hindenburg/7
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)groupvdbob.tcl    /main/hindenburg/7   7 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 GroupVDbObj : {BrowsDbObj GroupVersion VersionObj} {
  18.     method destructor
  19.     constructor
  20.     method promoter
  21.     method canBeDragged
  22.     method changeLinks
  23.     method copyVersion
  24.     method directFileVersions
  25.     method directSubgroupVersions
  26.     method editFile
  27.     method filterFileVersions
  28.     method filterItems
  29.     method filterSubgroupVersions
  30.     method group
  31.     method initializeInfo
  32.     method linkStatus
  33.     method name
  34.     method newObjects
  35.     method openFile
  36.     method printObjects
  37.     method removeObjects
  38.     method removeVersion
  39.     method savedGroupVersions
  40.     method showFile
  41.     method snapshotObjects
  42.     attribute savedGroupVersionSet
  43. }
  44.  
  45. method GroupVDbObj::destructor {this} {
  46.     # Start destructor user section
  47.  
  48.     [$this controlledListSet] delete
  49.     [$this savedGroupVersionSet] delete
  50.  
  51.     # End destructor user section
  52.     $this BrowsDbObj::destructor
  53.     $this VersionObj::destructor
  54. }
  55.  
  56. constructor GroupVDbObj {class this name} {
  57.     set this [GroupVersion::constructor $class $this $name]
  58.     set this [BrowsDbObj::constructor $class $this $name]
  59.     set this [VersionObj::constructor $class $this $name]
  60.     return $this
  61. }
  62.  
  63. selfPromoter GroupVersion {this} {
  64.     GroupVDbObj promote $this
  65. }
  66.  
  67. method GroupVDbObj::promoter {this} {
  68.     $this BrowsDbObj::promoter
  69.  
  70.     set controlledListSet $this.${CListUiObj::uiClass}:0
  71.     if {! [isCommand $controlledListSet]} {
  72.     CListUiObj new $controlledListSet -parent $this
  73.     }
  74.     $this controlledListSet $controlledListSet
  75.     set savedGroupVersionSet $this.${SvdGVUiObj::uiClass}:0
  76.     if {! [isCommand $savedGroupVersionSet]} {
  77.     SvdGVUiObj new $savedGroupVersionSet -parent $this
  78.     }
  79.     $this savedGroupVersionSet $savedGroupVersionSet
  80. }
  81.  
  82. proc GroupVDbObj::associations {} {
  83.     return {\
  84.     directFileVersions directSubgroupVersions savedGroupVersionSet \
  85.     controlledListSet accessRuleSet\
  86.     }
  87. }
  88.  
  89. method GroupVDbObj::canBeDragged {this} {
  90.     return 1
  91. }
  92.  
  93. method GroupVDbObj::changeLinks {this} {
  94.     [$this getParent SystemVersion] changeLinks
  95. }
  96.  
  97. proc GroupVDbObj::childTypes {assoc} {
  98.     if {[lsearch -exact "[GroupVDbObj::associations]" "$assoc"] == -1} {
  99.     return ""
  100.     }
  101.     set childTypes [BrowserProcs::childTypes "$assoc"]
  102.     case "$childTypes" in {
  103.     {DirectFileVersion} {
  104.         return [concat \
  105.         ${BrowserProcs::diagramFileTypes} \
  106.         ${BrowserProcs::programmerFileTypes}]
  107.     }
  108.     {DirectSubgroupVersion} {
  109.         return "GroupVersion"
  110.     }
  111.     {default} {
  112.         return "$childTypes"
  113.     }
  114.     }
  115. }
  116.  
  117. proc GroupVDbObj::controlledLists {} {
  118.     return {"[[$this group] groupVersionList]"}
  119. }
  120.  
  121. method GroupVDbObj::copyVersion {this} {
  122.     set versionList ""
  123.     foreach system [[$this phase] systems] {
  124.     foreach group [$system groups] {
  125.         foreach version [$group groupVersions] {
  126.         if {"$version" == "$this"} continue
  127.         lappend versionList [list $version "[$group name]"]
  128.         }
  129.     }
  130.     }
  131.     BrowserProcs::copyVersion $this $versionList
  132. }
  133.  
  134. method GroupVDbObj::directFileVersions {this} {
  135.     set link [[$this info] set SystemGroupLink]
  136.     if [isCommand $link] {
  137.     set sysV [$link systemVersion]
  138.     } else {
  139.     set sysV [$this getParent SystemVersion]
  140.     }
  141.     foreach fileV [$this explicitFileVersions $sysV] {
  142.     set directFileVersions($fileV) 1
  143.     }
  144.     foreach fileV [$this GroupVersion::filterFileVersions $sysV] {
  145.     set directFileVersions($fileV) 1
  146.     }
  147.     if [info exists directFileVersions] {
  148.     return [array names directFileVersions]
  149.     }
  150.     return ""
  151. }
  152.  
  153. method GroupVDbObj::directSubgroupVersions {this} {
  154.     set link [[$this info] set SystemGroupLink]
  155.     if [isCommand $link] {
  156.     set sysV [$link systemVersion]
  157.     } else {
  158.     set sysV [$this getParent SystemVersion]
  159.     }
  160.     foreach subgroupV [$this explicitSubgroupVersions $sysV] {
  161.     set directSubgroupVersions($subgroupV) 1
  162.     }
  163.     foreach subgroupV [$this GroupVersion::filterSubgroupVersions $sysV] {
  164.     set directSubgroupVersions($subgroupV) 1
  165.     }
  166.     if [info exists directSubgroupVersions] {
  167.     return [array names directSubgroupVersions]
  168.     }
  169.     return ""
  170. }
  171.  
  172. method GroupVDbObj::editFile {this} {
  173.     require "groupvstrd.tcl"
  174.  
  175.     if {[$this getInfo Status] != "working"} {
  176.     $this showFile
  177.     return
  178.     }
  179.     global classCount
  180.     set box .main.groupVStructureDialog$classCount
  181.     incr classCount
  182.     GroupVStrDlg new $box $this \
  183.     -editable 1 \
  184.     -title "Edit Group Structure" \
  185.     -helpPressed {.main helpOnName groupVStructureDialog}
  186.     $box popUp
  187. }
  188.  
  189. method GroupVDbObj::filterFileVersions {this filter} {
  190.     set sysV [[[$this info] set SystemGroupLink] systemVersion]
  191.     if {"$filter" == ""} {
  192.     return [$this GroupVersion::filterFileVersions $sysV]
  193.     }
  194.     return [$sysV filterResult $filter]
  195. }
  196.  
  197. method GroupVDbObj::filterItems {this filter} {
  198.     set sysV [[[$this info] set SystemGroupLink] systemVersion]
  199.     if {"$filter" == ""} {
  200.     return [$this GroupVersion::filterItems $sysV]
  201.     }
  202.     return [$sysV filterResult $filter]
  203. }
  204.  
  205. method GroupVDbObj::filterSubgroupVersions {this filter} {
  206.     set sysV [[[$this info] set SystemGroupLink] systemVersion]
  207.     if {"$filter" == ""} {
  208.     return [$this GroupVersion::filterSubgroupVersions $sysV]
  209.     }
  210.     return [$sysV filterResult $filter]
  211. }
  212.  
  213. method GroupVDbObj::group {this} {
  214.     if {[catch {set group [[[$this info] set SystemGroupLink] group]}] ||
  215.     [$group isNil]} {
  216.     global errorInfo
  217.     set errorInfo ""
  218.     global errorCode
  219.     set errorCode ""
  220.     return [$this GroupVersion::group]
  221.     }
  222.     return $group
  223. }
  224.  
  225. proc GroupVDbObj::infoProperties {} {
  226.     return [concat \
  227.     [BrowserProcs::infoProperties] \
  228.     {Status Link Version Comments Created Updated Frozen \
  229.      "Controlled Actions" "Created By"} \
  230.     ]
  231. }
  232.  
  233. method GroupVDbObj::initializeInfo {this dummy} {
  234.     set oldLink [[$this info] set SystemGroupLink]
  235.     [$this info] contents ""
  236.     $this setInfo SystemGroupLink $oldLink
  237. }
  238.  
  239. method GroupVDbObj::linkStatus {this} {
  240.     return [[[$this info] set SystemGroupLink] status]
  241. }
  242.  
  243. method GroupVDbObj::name {this} {
  244.     return "[[$this group] name]"
  245. }
  246.  
  247. method GroupVDbObj::newObjects {this} {
  248.     [$this getParent SystemVersion] newObjects
  249. }
  250.  
  251. method GroupVDbObj::openFile {this} {
  252.     case [$this getInfo Status] in {
  253.     backGround {
  254.         set treeNode [$this treeNode]
  255.         if {"$treeNode" != ""} {
  256.         $treeNode open
  257.         } else {
  258.         [$this infoObject] open
  259.         }
  260.     }
  261.     working {
  262.         $this editFile
  263.     }
  264.     default {
  265.         $this showFile
  266.     }
  267.     } 
  268. }
  269.  
  270. method GroupVDbObj::printObjects {this} {
  271.     set asciiFiles ""
  272.     set topostObjects ""
  273.     foreach obj [$wmttoolObj selectedObjSet] {
  274.     if [$obj isA Graph] {
  275.         lappend topostObjects $obj
  276.     } elseif [$obj isA ExternalFileVersion] {
  277.         $obj synchWithFileSystem
  278.         lappend asciiFiles [$obj path]
  279.     }
  280.     }
  281.     BrowserProcs::printObjects $asciiFiles "" $topostObjects
  282. }
  283.  
  284. method GroupVDbObj::removeObjects {this} {
  285.     [$this getParent SystemVersion] removeObjects
  286. }
  287.  
  288. method GroupVDbObj::removeVersion {this} {
  289.     set versionList ""
  290.     foreach version [[$this group] groupVersions] {
  291.     if [$version isLeaf] {
  292.         lappend versionList $version
  293.     }
  294.     }
  295.     BrowserProcs::removeVersion \
  296.     [$this getParent SystemVersion] "[$this group]" "$versionList"
  297. }
  298.  
  299. method GroupVDbObj::savedGroupVersions {this} {
  300.     set savedGroup [[$this group] savedGroup]
  301.     if [$savedGroup isNil] {
  302.     return ""
  303.     }
  304.     return [$savedGroup savedGroupVersions]
  305. }
  306.  
  307. method GroupVDbObj::showFile {this} {
  308.     require "groupvstrd.tcl"
  309.  
  310.     global classCount
  311.     set box .main.groupVStructureDialog$classCount
  312.     incr classCount
  313.     GroupVStrDlg new $box $this \
  314.     -editable 0 \
  315.     -title "Show Group Structure" \
  316.     -helpPressed {.main helpOnName groupVStructureDialog}
  317.     $box popUp
  318. }
  319.  
  320. method GroupVDbObj::snapshotObjects {this} {
  321.     [$this getParent SystemVersion] snapshotObjects
  322. }
  323.  
  324. # Do not delete this line -- regeneration end marker
  325.  
  326.