home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / vssysvdbob.tcl < prev    next >
Encoding:
Text File  |  1997-05-16  |  17.1 KB  |  663 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)vssysvdbob.tcl    /main/hindenburg/7
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)vssysvdbob.tcl    /main/hindenburg/7   16 May 1997 Copyright 1997 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12. require_module_file "selectvers.tcl" vcm
  13. # End user added include file section
  14.  
  15. require "psysvdbobj.tcl"
  16.  
  17. Class VSSysVDbObj : {PSysVDbObj} {
  18.     constructor
  19.     method destructor
  20.     method browserType
  21.     method promoter
  22.     method copy
  23.     method changeSourceClass
  24.     method moveVersion
  25.     method selectVersion
  26.     method deselectVersion
  27.     method importObject
  28.     method initializeCustomization
  29.     method makeDirectoryList
  30.     method updateFileInfo
  31.     method updateUserEnv
  32.     method printObjects
  33.     method getObjHandler
  34.     method importFromPrevPhase
  35.     method removeObjects
  36.     method showPreviousVersion
  37.     method showOtherVersion
  38.     method diffPreviousVersion
  39.     method diffOtherVersion
  40.     method listVersions
  41.     method addDirectory
  42.     method removeDirectory
  43.  
  44.     # Indicates whether the customization files for this system have been read.
  45.     #
  46.     attribute initializedCustomization
  47.     attribute directorySet
  48. }
  49.  
  50. constructor VSSysVDbObj {class this name} {
  51.     set this [PSysVDbObj::constructor $class $this $name]
  52.     $this initializedCustomization 0
  53.     $this directorySet [List new]
  54.     # Start constructor user section
  55.     # End constructor user section
  56.     return $this
  57. }
  58.  
  59. method VSSysVDbObj::destructor {this} {
  60.     # Start destructor user section
  61.     # End destructor user section
  62.     $this PSysVDbObj::destructor
  63. }
  64.  
  65. proc VSSysVDbObj::associations {} {
  66.     return {externalLinks vsFiles customFileVersionSet}
  67. }
  68.  
  69. proc VSSysVDbObj::childTypes {assoc} {
  70.     if {[lsearch -exact "[VSSysVDbObj::associations]" "$assoc"] == -1} {
  71.         return ""
  72.     }
  73.  
  74.     set childTypes [BrowserProcs::childTypes $assoc]
  75.     case "$childTypes" in {
  76.     {VsFile} {
  77.         return "${BrowserProcs::programmerFileTypes}"
  78.     }
  79.     {default} {
  80.         return [SysVDbObj::childTypes "$assoc"]
  81.     }
  82.     }
  83. }
  84.  
  85. proc VSSysVDbObj::controlledLists {} {
  86.     return [PSysVDbObj::controlledLists]
  87. }
  88.  
  89. proc VSSysVDbObj::infoProperties {} {
  90.     return [PSysVDbObj::infoProperties]
  91. }
  92.  
  93.  
  94. # Returns special VS system type.
  95. #
  96. method VSSysVDbObj::browserType {this} {
  97.     return "VCMSystemVersion"
  98. }
  99.  
  100. method VSSysVDbObj::promoter {this} {
  101.     VSTypeMapper new $this
  102.     $this directorySet [List new]
  103.     $this initializedCustomization 0
  104. }
  105.  
  106.  
  107. # Extension of copy with support for Edit etc.
  108. # Only do it if file is a VSFile, otherwise pass to superclass.
  109. #
  110. method VSSysVDbObj::copy {this args} {
  111.     set argc [llength $args]
  112.  
  113.     # it's not a VSFile: don't touch it
  114.     if { [lindex $args 0] != "\-vsFile" } {
  115.     eval $this PSysVDbObj::copy $args
  116.     return
  117.     }
  118.  
  119.     # make sure this system is initialized
  120.     $this initializeVCMVars
  121.     if { ![$this initializedCustomization] } {
  122.     $this initializeCustomization
  123.     }
  124.  
  125.     set vsFile [lindex $args 1]
  126.  
  127.     if  { $argc <= 2 } {
  128.     eval $this VSSystem::copy $vsFile
  129.     return
  130.     }
  131.  
  132.     set editPasteCmdBusy [lindex $args [expr $argc -1]]
  133.     set newVSFile [$this VSSystem::copy $vsFile]
  134.     if {$editPasteCmdBusy && ( $newVSFile != "" )} {
  135.     [.main undoCommand] sourceObj [$vsFile systemVersion]
  136.     [.main undoCommand] addObject $newVSFile
  137.     }
  138. }
  139.  
  140.  
  141. # Pops up a singeline text dialog for
  142. # changing the source class of the file.
  143. #
  144. method VSSysVDbObj::changeSourceClass {this} {
  145.     .main busy 1
  146.     if { ![isCommand .main.changesource] } {
  147.     EntryDialog new .main.changesource -title "Change Source Class"
  148.     }
  149.  
  150.     set vsFile [lindex [.main selectedObjSet] 0]
  151.     .main.changesource config \
  152.         -message "Source class for file [$vsFile name]:" \
  153.         -entry [$vsFile getClass] \
  154.         -okPressed "$vsFile setClass \[.main.changesource entry\]; $vsFile setInfo \"Generated From Class\" \[.main.changesource entry\]"
  155.     .main busy 0
  156.  
  157.     .main.changesource delHelpButton
  158.     .main.changesource popUp
  159. }
  160.  
  161.  
  162. # Move specified version to this system.
  163. #
  164. method VSSysVDbObj::moveVersion {this args} {
  165.     # make sure this system is initialized
  166.     $this initializeVCMVars
  167.     if { ![$this initializedCustomization] } {
  168.     $this initializeCustomization
  169.     }
  170.  
  171.     set vsFile [lindex $args 0]
  172.     set sourceSys [lindex $args 1]
  173.     set editPasteCmdBusy [lindex $args 2]
  174.     if { ![$this move $vsFile] } {
  175.     return
  176.     }
  177.  
  178.     # make new object
  179.     set type [$vsFile type]
  180.     set objectName [$this getObjectName [$vsFile name] $type]
  181.     set newVSFile [VSFile new $objectName $type $this]
  182.     
  183.     # check if copy succeeded
  184.     if { $newVSFile == "" } {
  185.     return ""
  186.     }
  187.  
  188.     $this promoteFile $newVSFile
  189.  
  190.     # check out if necessary
  191.     set userPath [$newVSFile path]
  192.     if { ![$newVSFile isCheckedOut] } {
  193.     set comment "Moved from [$vsFile vsPath]"
  194.     if { ![$newVSFile checkOut $comment] } {
  195.         return ""
  196.     }
  197.     }
  198.  
  199.     if {$editPasteCmdBusy && ( $newVSFile != "" )} {
  200.     [.main undoCommand] sourceObj $sourceSys
  201.     [.main undoCommand] addObject $newVSFile
  202.     }
  203. }
  204.  
  205. method VSSysVDbObj::selectVersion {this version {confV ""}} {
  206.     # check if it's a VS file
  207.     if { ![$version isA VSFile] } {
  208.     $this PSysVDbObj::selectVersion $version
  209.     return
  210.     }
  211.  
  212.     if {"[[.main undoCommand] operation]" == "cut"} {
  213.     wmtkmessage "Moving [$version getInfo Text]"
  214.     if [$this move $version] {
  215.         [.main undoCommand] removeObject $version
  216.         [.main undoCommand] addObject \
  217.             [$this getObjectName [$version name] [$version type]]
  218.     }        
  219.     wmtkmessage ""
  220.     } else {
  221.     set sourceSys [[.main undoCommand] sourceObj]
  222.     set sourceFile [$sourceSys getObjectName [$version name] [$version type]]
  223.     wmtkmessage "Copying [$sourceFile getInfo Text]"
  224.     $this VSSystem::copy $sourceFile
  225.     wmtkmessage ""
  226.     }
  227. }
  228.  
  229. method VSSysVDbObj::deselectVersion {this version} {
  230.     if { ![$version isA VSFile] } {
  231.     $this PSysVDbObj::deselectVersion $version
  232.     return
  233.     }
  234.  
  235.     if {"[[.main undoCommand] operation]" == "cut"} {
  236.     wmtkmessage "Moving [$version getInfo Text]"
  237.     set sys [[.main undoCommand] sourceObj]
  238.  
  239.     # make sure  sys is initialized
  240.     $sys initializeVCMVars
  241.     if { ![$sys initializedCustomization] } {
  242.         $sys initializeCustomization
  243.     }
  244.  
  245.     if [$sys move $version] {
  246.         [.main undoCommand] removeObject $version
  247.         [.main undoCommand] addObject \
  248.             [$sys getObjectName [$version name] [$version type]]
  249.     }
  250.     wmtkmessage ""
  251.     } else {
  252.     $version removeFromVS
  253.     }
  254. }
  255.  
  256. method VSSysVDbObj::importObject {this context node} {
  257.     # context is: project, configversion, phaseversion
  258.     # systemversion, file, type, uiClass
  259.     set isAVSFile 0
  260.     set len [llength $context]
  261.     if { $len == 7 } {
  262.     set fileId [lindex $context 4]
  263.     if [regexp VSFile $fileId] {
  264.         set isAVSFile 1
  265.     }
  266.     }
  267.  
  268.     # if it's not a vs file leave it
  269.     if !$isAVSFile {
  270.     $this PSysVDbObj::importObject $context $node
  271.     return
  272.     }
  273.  
  274.     if {$this == [[.main currentObj] browsUiObj]} {
  275.     set update 1
  276.     } else {
  277.     set update 0
  278.     }
  279.  
  280.     # sanity check: systems must be different
  281.     set sysVId [lindex $context 3]
  282.     if {$sysVId == [$this getInfo Identity]} {
  283.     wmtkmessage "Can not import object into its own parent"
  284.     if [isCommand [.main undoCommand]] {
  285.         [.main undoCommand] delete
  286.     }
  287.     return
  288.     }
  289.  
  290.     # retrieve source info
  291.     set sysV [BrowserProcs::id2obj $sysVId SystemVersion $node]
  292.     regsub -all {\.} $sysVId "_" sysId
  293.     set vsFile "${sysId}_$fileId"
  294.  
  295.     # Make sure vsFile exists
  296.     if [catch {$vsFile name}] {
  297.     wmtkinfo "Can not import [lindex $context 5] because it is removed"
  298.     if [isCommand [.main undoCommand]] {
  299.         [.main undoCommand] delete
  300.     }
  301.     return
  302.     }
  303.  
  304.     # Move imported object in case of a cut operation
  305.     set editPasteCmdBusy [.main undoCommandBusy EditPasteCmd]
  306.     if {$editPasteCmdBusy && \
  307.         "[[.main undoCommand] operation]" == "cut"} {
  308.     set script "$this moveVersion $vsFile $sysV $editPasteCmdBusy"
  309.     set action "Moving"
  310.     } else {
  311.     set script "$this copy -vsFile $vsFile $editPasteCmdBusy"
  312.     set action "Copying"
  313.     }
  314.  
  315.     $wmttoolObj startCommand tcl "$script" "" \
  316.     "$action [$vsFile getInfo Text]" [list $update 0] 1
  317. }
  318.  
  319.  
  320. # Read type mapping and u_vcm.tcl and set
  321. # initializedCustomization.
  322. #
  323. method VSSysVDbObj::initializeCustomization {this} {
  324.     # switch client context to read customization file if needed
  325.     # otherwise we get the wrong or no customization files
  326.     set oldLevelPath ""
  327.     if { [[ClientContext::global] currentCustomLevel] != $this } {
  328.     set cc [ClientContext::global]
  329.     $cc notifyDisable
  330.     set oldLevelPath [$cc currentLevelIdString]
  331.     global ${this}::treeNode
  332.     set treeNode [set ${this}::treeNode]
  333.     set phase [$treeNode parent]
  334.     set config [$phase parent]
  335.     set project [$config parent]
  336.     set corporate [$cc currentCorporate]
  337.     set newPath "/[$corporate identity]/[[$project browsUiObj] identity]"
  338.     append newPath "/[[$config browsUiObj] identity]/"
  339.     append newPath "[[$phase browsUiObj] identity]/[$this identity]"
  340.     $cc setLevelIds $newPath
  341.  
  342.     }
  343.  
  344.     [$this typeMapper] initialize
  345.  
  346.     # source u_vcm.tcl
  347.     eval [[ClientContext::global] getCustomFileContents u_vcm tcl etc]
  348.  
  349.     if { $oldLevelPath != "" } {
  350.     $cc setLevelIds $oldLevelPath
  351.     $cc notifyEnable
  352.     }
  353.  
  354.     $this initializedCustomization 1
  355. }
  356.  
  357.  
  358. # Determines the directories used by this
  359. # system, compares this with the repository links and 
  360. # updates if necessary, and sets the directory
  361. # association.
  362. #
  363. method VSSysVDbObj::makeDirectoryList {this} {
  364.     # not yet available
  365. }
  366.  
  367.  
  368. # Updates the cached information for these files.
  369. #
  370. method VSSysVDbObj::updateFileInfo {this files} {
  371.     foreach file $files {
  372.     # invalidate cached info
  373.     $file updatePath
  374.     $file initializedAllInfo 0
  375.     }
  376. }
  377.  
  378.  
  379. # Updates the user environment files.
  380. #
  381. method VSSysVDbObj::updateUserEnv {this} {
  382.     # VCM systems will redefine this if it make sense
  383.     # menu entry disabling should prevent this from being called
  384.     wmtkinfo "You should not be able to use this function"
  385. }
  386.  
  387.  
  388. # Send objects to printer.
  389. #
  390. method VSSysVDbObj::printObjects {this} {
  391.     # this variable will hold script to delete file references after
  392.     # printing
  393.     set vsFileDeleteRefs ""
  394.  
  395.     # this variable holds the path list of files to print
  396.     set pathList ""
  397.  
  398.     foreach obj [.main selectedObjSet] {
  399.     if [$obj isA VSFile] {
  400.         # get a reference: a path to the required version
  401.         set path [$obj getReference]
  402.         if { $vsFileDeleteRefs != "" } {
  403.         append vsFileDeleteRefs "; "
  404.         }
  405.         append vsFileDeleteRefs "$obj deleteReference [list $path]"
  406.     } else {
  407.         set path [$obj path]
  408.     }
  409.     append pathList " [list $path]"
  410.     }
  411.  
  412.     # make print command
  413.     set printCommand [m4_var get M4_a_printer]
  414.     if !$win95 {
  415.     set message "Sending files to $printCommand..."
  416.     set printFiles "$printCommand $pathList"
  417.     .main startCommand extern "$printFiles" "$vsFileDeleteRefs" \
  418.         "$message" {0 0} 0
  419.     return
  420.     }
  421.  
  422.     # one by one for Windows
  423.     foreach path $pathList {
  424.     set printFile "$printCommand $path"
  425.     if { ![regexp {([^;]*);(.*)} $vsFileDeleteRefs \
  426.         dummy deleteRef vsFileDeleteRefs] } {
  427.         set deleteRef $vsFileDeleteRefs
  428.     }
  429.     set message "Sending $path to $printCommand..."
  430.     .main startCommand extern "$printFile" "$deleteRef" \
  431.         "$message" {0 0} 0
  432.     }
  433. }
  434.  
  435.  
  436. # Returns the CustObjHandler of .main
  437. #
  438. method VSSysVDbObj::getObjHandler {this} {
  439.     return [.main objectHdlr]
  440. }
  441.  
  442. method VSSysVDbObj::importFromPrevPhase {this mode} {
  443.     if  {"$mode" == "selected"} {
  444.     set tmpFile [args_file {}]
  445.     set fid [open $tmpFile w]
  446.  
  447.     foreach obj [.main selectedObjSet] {
  448.         if [$obj isA SystemFileReference] {
  449.         set confV [$obj getParent ConfigVersion]
  450.         set fileV [$obj referredFileVersion]
  451.         if [$fileV isA ExternalFileVersion] {
  452.             puts $fid "[$fileV identity]"
  453.         }
  454.         } elseif [$obj isA ExternalFileVersion] {
  455.         puts $fid "[$obj identity]"
  456.         } elseif [$obj isA VSFile] {
  457.         set name [$obj name]
  458.         set type [$obj type]
  459.         if { $type != "" } {
  460.             set fileSpec "$name.$type"
  461.         } else {
  462.             set fileSpec "$name"
  463.         }
  464.         puts $fid "$fileSpec"
  465.         }
  466.     }
  467.  
  468.     close $fid
  469.     set options "-S oopl -t $tmpFile -f import.tcl"
  470.     set script "[quoteIf [m4_path_name bin otsh$EXE_EXT]] $options"
  471.     .main startCommand mtool \
  472.         "$script" "" \
  473.         "Starting 'Import From Previous Phase'..." \
  474.         {1 0} 0
  475.     } else {
  476.     set box .main.importNew
  477.     if {! [isCommand $box]} {
  478.         interface TemplateDialog $box {
  479.         title "Import New"
  480.         modal yes
  481.         DlgColumn DC {
  482.             Label L {
  483.             text "Import new"
  484.             alignment CENTER
  485.             }
  486.             CheckButton SQLCB {
  487.             label SQL
  488.             }
  489.             CheckButton OOPLCB {
  490.             label OOPL
  491.             }
  492.         }
  493.         }
  494.         $box config \
  495.         -helpPressed {.main helpOnName importNew} \
  496.         -okPressed {
  497.             if [%this.DC.SQLCB state] {
  498.             set options "-S sql "
  499.             } else {
  500.             set options ""
  501.             }
  502.             if [%this.DC.OOPLCB state] {
  503.             append options "-S oopl "
  504.             }
  505.             append options "-f import.tcl"
  506.             set script "[quoteIf [m4_path_name bin otsh$EXE_EXT]] $options"
  507.             .main startCommand mtool \
  508.             "$script" "" \
  509.             "Starting 'Import From Previous Phase'..." \
  510.             {1 0} 0
  511.         }
  512.     }
  513.     $box popUp
  514.     }
  515. }
  516.  
  517. method VSSysVDbObj::removeObjects {this} {
  518.     set box $wmttoolObj.removeWarning
  519.     ClassMaker::extend WarningDialog RemoveObjectsWarningDialog dbObj
  520.     RemoveObjectsWarningDialog new $box \
  521.         -title "Delete Warning" \
  522.         -message [BrowserProcs::removeMessage] \
  523.         -dbObj $this \
  524.         -helpPressed {.main helpOnName removeWarning} \
  525.         -cancelPressed {%this delete} \
  526.         -okPressed {
  527.     set dbObj [%this dbObj]
  528.     set script ""
  529.     set update 0
  530.     busy {
  531.         vsCommandHandler suspendOutput
  532.         foreach obj [$wmttoolObj selectedObjSet] {
  533.         if {"$script" != ""} {
  534.             append script " ;"
  535.         }
  536.         if [$obj isA VSFile] {
  537.             # remove from VS if it still exists there.
  538.             set system [[.main currentObj] browsUiObj]
  539.             if [$system fileExists [$obj name] [$obj type]] {
  540.             if { ![$obj removeFromVS] } {
  541.                 break
  542.             }
  543.             set update 1
  544.             }
  545.         } else {
  546.             append script " $dbObj removeObject $obj"
  547.         }
  548.         }
  549.     }
  550.     %this delete
  551.     if { $script != "" } {
  552.         $wmttoolObj startCommand tcl "$script" "vsCommandHandler showOutput" "" {1 0} 1
  553.     } else {
  554.         if $update {
  555.         .main updateView
  556.         wmtkmessage ""
  557.         vsCommandHandler showOutput
  558.         }
  559.     }
  560.     }
  561.     $box popUp
  562. }
  563.  
  564.  
  565. # Shows the prvious version of this file.
  566. #
  567. method VSSysVDbObj::showPreviousVersion {this} {
  568.     set selectedFile [lindex [.main selectedObjSet] 0]
  569.     set previousVersion [$selectedFile previousVersion]
  570.  
  571.     if { $previousVersion == "" } {
  572.     wmtkinfo "There is no previous version"
  573.     return
  574.     }
  575.  
  576.     $selectedFile showFileVersion $previousVersion
  577. }
  578.  
  579.  
  580. # Show another version of this file.
  581. #
  582. method VSSysVDbObj::showOtherVersion {this} {
  583.     set selectedFile [lindex [.main selectedObjSet] 0]
  584.     set versions [$selectedFile otherVersions]
  585.     if { $versions == "" } {
  586.     wmtkinfo "There are no other versions"
  587.     return
  588.     }
  589.  
  590.     SelectVersionDialog new .main.selectversion \
  591.         -title "Show Other Version" \
  592.         -file $selectedFile \
  593.         -entrySet $versions \
  594.         -options "" \
  595.         -command "showFileVersion"
  596.  
  597.     .main.selectversion popUp
  598. }
  599.  
  600.  
  601. # Shows diff of selected file with previous version.
  602. #
  603. method VSSysVDbObj::diffPreviousVersion {this {options ""}} {
  604.     set selectedFile [lindex [.main selectedObjSet] 0]
  605.     set previousVersion [$selectedFile previousVersion]
  606.     if { $previousVersion == "" } {
  607.     wmtkinfo "There is no previous version"
  608.     return
  609.     }
  610.  
  611.     $selectedFile showDiff $previousVersion $options
  612. }
  613.  
  614.  
  615. # Pops up version selection dialog and shows diff
  616. # with selected version.
  617. #
  618. method VSSysVDbObj::diffOtherVersion {this {options ""}} {
  619.     set selectedFile [lindex [.main selectedObjSet] 0]
  620.     set versions [$selectedFile otherVersions]
  621.     if { $versions == "" } {
  622.     wmtkinfo "There are no other versions"
  623.     return
  624.     }
  625.  
  626.     SelectVersionDialog new .main.selectversion \
  627.         -title "Show Diff with Other Version" \
  628.         -file $selectedFile \
  629.         -entrySet $versions \
  630.         -options $options \
  631.         -command "showDiff"
  632.  
  633.     .main.selectversion popUp
  634. }
  635.  
  636.  
  637. # List the version of this file in an info dialog.
  638. #
  639. method VSSysVDbObj::listVersions {this} {
  640.     set selectedFile [lindex [.main selectedObjSet] 0]
  641.     set versions [$selectedFile otherVersions]
  642.     if { $versions == "" } {
  643.     wmtkinfo "There are no other versions of [path_name file [$selectedFile path]]"
  644.     return
  645.     }
  646.  
  647.     set versionOutput [join $versions "\n"]
  648.     set message "Other versions of [$selectedFile path]:\n\n$versionOutput"
  649.     wmtkinfo "$message"
  650. }
  651.  
  652. # Do not delete this line -- regeneration end marker
  653.  
  654. method VSSysVDbObj::addDirectory {this newDirectory} {
  655.     [$this directorySet] append $newDirectory
  656.  
  657. }
  658.  
  659. method VSSysVDbObj::removeDirectory {this oldDirectory} {
  660.     [$this directorySet] removeValue $oldDirectory
  661. }
  662.  
  663.