home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / sfileldbob.tcl < prev    next >
Text File  |  1997-11-18  |  7KB  |  277 lines

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