home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / sfileldbob.tcl < prev    next >
Encoding:
Text File  |  1996-10-08  |  7.5 KB  |  287 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cadre Technologies Inc.    1996
  4. #
  5. #      File:           @(#)sfileldbob.tcl    /main/hindenburg/1
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)sfileldbob.tcl    /main/hindenburg/1   8 Oct 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.  
  16. Class SFileLDbObj : {SystemFileReference BrowsDbObj} {
  17.     method destructor
  18.     constructor
  19.     method browserType
  20.     method browserObjType
  21.     method compareVersion
  22.     method compareVersionAllowed
  23.     method editFile
  24.     method hasChildren
  25.     method initializeInfo
  26.     method pathName
  27.     method previewFile
  28.     method referredFileVersion
  29.     method referredSystemVersion
  30.     method selectFixed
  31.     method showFile
  32.     method versionName
  33. }
  34.  
  35. method SFileLDbObj::destructor {this} {
  36.     # Start destructor user section
  37.     # End destructor user section
  38.     $this BrowsDbObj::destructor
  39. }
  40.  
  41. constructor SFileLDbObj {class this name} {
  42.     set this [SystemFileReference::constructor $class $this $name]
  43.     set this [BrowsDbObj::constructor $class $this $name]
  44.     return $this
  45. }
  46.  
  47. selfPromoter SystemFileReference {this} {
  48.     SFileLDbObj promote $this
  49. }
  50.  
  51. proc SFileLDbObj::associations {} {
  52.     return {accessRuleSet}
  53. }
  54.  
  55. method SFileLDbObj::browserType {this} {
  56.     return "[$this type]"
  57. }
  58.  
  59. method SFileLDbObj::browserObjType {this} {
  60.     return "SFileLDbObj"
  61. }
  62.  
  63. proc SFileLDbObj::childTypes {assoc} {
  64.     if {[lsearch -exact "[SFileLDbObj::associations]" "$assoc"] == -1} {
  65.     return ""
  66.     }
  67.     return "[BrowserProcs::childTypes $assoc]"
  68. }
  69.  
  70. method SFileLDbObj::compareVersion {this} {
  71.     set versionList ""
  72.     set fileV [[$this info] set FileVersion]
  73.     foreach version [[$fileV file] fileVersions] {
  74.     if {"$version" == "$fileV"} continue
  75.     lappend versionList $version
  76.     }
  77.     BrowserProcs::compareVersion $fileV [$fileV file] $versionList
  78. }
  79.  
  80. method SFileLDbObj::compareVersionAllowed {this} {
  81.     if [[[$this info] set FileVersion] isNil] {
  82.     return 0
  83.     }
  84.  
  85.     return 1
  86. }
  87.  
  88. proc SFileLDbObj::controlledLists {} {
  89.     return ""
  90. }
  91.  
  92. method SFileLDbObj::editFile {this} {
  93.     set fileV [[$this info] set FileVersion]
  94.     if {! [$fileV isNil]} {
  95.     if {[$fileV inCorporate] || "[$fileV status]" != "working"} {
  96.         $this showFile
  97.         return
  98.     }
  99.     if [$this isA DocSection] {
  100.         $this edit
  101.     } else {
  102.         set sysV [$this referredSystemVersion]
  103.         if [$sysV isNil] {
  104.         wmtkerror "Can not edit \
  105.              [$this getInfo Type] '[$this getInfo Name]':\n    \
  106.              System '[[$this referredSystem] name]' is not \
  107.              selected within the current PhaseVersion"
  108.         return
  109.         }
  110.         set phaseV [$this getParent PhaseVersion]
  111.         set confV [$this getParent ConfigVersion]
  112.         $fileV editFile $confV $phaseV $sysV
  113.     }
  114.     }
  115. }
  116.  
  117. method SFileLDbObj::hasChildren {this} {
  118.     return 1
  119. }
  120.  
  121. proc SFileLDbObj::infoProperties {} {
  122.     return [concat \
  123.     [BrowserProcs::infoProperties] \
  124.     {Status Version "Controlled Actions" Path} \
  125.     ]
  126. }
  127.  
  128. method SFileLDbObj::initializeInfo {this dummy} {
  129.     [$this info] contents ""
  130.     $this setInfo FileVersion [$this referredFileVersion]
  131. }
  132.  
  133. method SFileLDbObj::pathName {this} {
  134.     if {! [$this isA DocSection]} {
  135.     return ""
  136.     }
  137.     return "[path_name concat \
  138.     [[$this document] directory] [$this getPropertyValue fileSystemPath] \
  139.     ]"
  140. }
  141.  
  142. method SFileLDbObj::previewFile {this} {
  143.     if {! [$this isDocDirUpToDate]} {
  144.     set confVId [[$this getParent ConfigVersion] identity]
  145.     set sysVId [[$this getParent SystemVersion] identity]
  146.     set argsfile [args_file [$this identity]]
  147.     set args "updateDocDir $confVId $sysVId [list $argsfile]"
  148.     set cmd "\
  149.         if \[lindex \[$wmttoolObj exitStatusList\] 0\] {\
  150.         $this preview\
  151.         }"
  152.     $wmttoolObj startDocbatch mtool "$args" "$cmd" {0 0} 0
  153.     } else {
  154.     $this preview
  155.     }
  156. }
  157.  
  158. method SFileLDbObj::referredFileVersion {this} {
  159.     set fileV [$this SystemFileReference::referredFileVersion]
  160.     if {! [$fileV isNil]} {
  161.     return $fileV
  162.     }
  163.     set confV [$this getParent ConfigVersion]
  164.     if {"$confV" == ""} {
  165.     set confV [[ClientContext::global] currentConfig]
  166.     }
  167.     if [$confV isNil] {
  168.     return $confV
  169.     }
  170.     return [[$this referredFile] selectedVersion $confV]
  171. }
  172.  
  173. method SFileLDbObj::referredSystemVersion {this} {
  174.     set confV [$this getParent ConfigVersion]
  175.     if {"$confV" == ""} {
  176.     set confV [[ClientContext::global] currentConfig]
  177.     }
  178.     if [$confV isNil] {
  179.     return $confV
  180.     }
  181.     return [[$this referredSystem] selectedVersion $confV]
  182. }
  183.  
  184. method SFileLDbObj::selectFixed {this} {
  185.     set versionList ""
  186.     set file [$this referredFile]
  187.     set fileV [[$this info] set FileVersion]
  188.     foreach version [$file fileVersions] {
  189.     if {"$version" == "$fileV"} continue
  190.     lappend versionList $version
  191.     }
  192.  
  193.     if [lempty $versionList] {
  194.     wmtkinfo "There are no other versions to select from"
  195.     return
  196.     }
  197.  
  198.     set headerSpecList {
  199.     {Version 25 ascii {increasing 1}}
  200.     {Status 14 ascii {increasing 2}}
  201.     {"Frozen date" 30 ascii {none}}
  202.     {Comments 50 ascii {none}}
  203.     }
  204.     set objectSpecList ""
  205.     foreach version $versionList {
  206.     set typeSpec [getObjectSpec [$wmttoolObj objectHdlr] \
  207.         [$version uiClass] [$version browserType] \
  208.     ]
  209.     if {"$typeSpec" != ""} {
  210.         set icon [$typeSpec smallIcon]
  211.     } else {
  212.         set icon ""
  213.     }
  214.     lappend objectSpecList [list $icon \
  215.         [$version versionName] \
  216.         [$version status] \
  217.         [$version freezeTime2String] \
  218.         [$version comments] \
  219.     ]
  220.     }
  221.  
  222.     require "browsviewd.tcl"
  223.     set box $wmttoolObj.selectFixed
  224.     ClassMaker::extend BrowsViewDialog SelectFixedBrowsViewDialog dbObj
  225.     SelectFixedBrowsViewDialog new $box \
  226.     -title "Select Fixed" \
  227.     -message "File '[$file name].[$file type]'" \
  228.     -headerSpecList $headerSpecList \
  229.     -objectSpecList $objectSpecList \
  230.     -objectList $versionList \
  231.     -dbObj $this \
  232.     -cancelPressed {%this delete} \
  233.     -okPressed {
  234.         set dbObj [%this dbObj]
  235.         set version [[lindex [[%this view] selectedSet] 0] object]
  236.         set script "$dbObj makeFixed $version"
  237.  
  238.         if [$dbObj isA DocSection] {
  239.         set confVId [[$dbObj getParent ConfigVersion] identity]
  240.         set sysVId [[$dbObj getParent SystemVersion] identity]
  241.         set argsfile [args_file [$dbObj identity]]
  242.         set args "updateDocDir $confVId $sysVId [list $argsfile]"
  243.         set cmd \
  244.             "$wmttoolObj startDocbatch mtool [list $args] \"\" {0 0} 0"
  245.         } else {
  246.         set cmd ""
  247.         }
  248.  
  249.         $wmttoolObj startCommand tcl "$script" "$cmd" "" {1 0} 1
  250.         %this delete
  251.     }
  252.     [$box view] selectionPolicy BROWSE
  253.     $box popUp
  254. }
  255.  
  256. method SFileLDbObj::showFile {this} {
  257.     set fileV [[$this info] set FileVersion]
  258.     if {! [$fileV isNil]} {
  259.     if [$this isA DocSection] {
  260.         $this show
  261.     } else {
  262.         set sysV [$this referredSystemVersion]
  263.         if [$sysV isNil] {
  264.         wmtkerror "Can not show \
  265.              [$this getInfo Type] '[$this getInfo Name]':\n    \
  266.              System '[[$this referredSystem] name]' is not \
  267.              selected within the current PhaseVersion"
  268.         return
  269.         }
  270.         set phaseV [$this getParent PhaseVersion]
  271.         set confV [$this getParent ConfigVersion]
  272.         $fileV showFile $confV $phaseV $sysV
  273.     }
  274.     }
  275. }
  276.  
  277. method SFileLDbObj::versionName {this} {
  278.     set fileV [[$this info] set FileVersion]
  279.     if [$fileV isNil] {
  280.     return ""
  281.     }
  282.     return [$fileV versionName]
  283. }
  284.  
  285. # Do not delete this line -- regeneration end marker
  286.  
  287.