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