home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / mtversionm.tcl < prev    next >
Encoding:
Text File  |  1997-11-26  |  4.3 KB  |  186 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)mtversionm.tcl    /main/titanic/15
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)mtversionm.tcl    /main/titanic/15   26 Nov 1997 Copyright 1997 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12. # End user added include file section
  13.  
  14.  
  15. Class MTVersionMenuProcs : {Object} {
  16.     constructor
  17.     method destructor
  18. }
  19.  
  20. constructor MTVersionMenuProcs {class this} {
  21.     set this [Object::constructor $class $this $name]
  22.     # Start constructor user section
  23.     # End constructor user section
  24.     return $this
  25. }
  26.  
  27. method MTVersionMenuProcs::destructor {this} {
  28.     # Start destructor user section
  29.     # End destructor user section
  30. }
  31.  
  32. proc MTVersionMenuProcs::merge {} {
  33.     
  34.     set parentObj [[.main currentObj] repObj]
  35.     set warning "Merge not (completely) successful for object "
  36.  
  37.     set reload 0
  38.     busy {
  39.         foreach obj [.main selectedObjSet] {
  40.     
  41.             if [[$obj repObj] merge] {
  42.                 set reload 1
  43.             } else {
  44.                 wmtkwarning "$warning '[$obj label]'."
  45.                 if [[$obj repObj] isA MTContainer] {
  46.                     # reload because some underlaying
  47.                     # elements can be succeeded
  48.                     set reload 1
  49.                 }
  50.             }
  51.         }
  52.  
  53.     }
  54.  
  55.     if {$reload == 1} {
  56.         MTFileMenuProcs::reload
  57.     }
  58.  
  59.     .main setCurrentContextVars    
  60. }
  61.  
  62. proc MTVersionMenuProcs::import {} {
  63.  
  64.     set parentObj [[.main currentObj] repObj]
  65.     set warning "Merge not (completely) successful for object "
  66.  
  67.     set reload 0
  68.     busy {
  69.         foreach obj [.main selectedObjSet] {
  70.     
  71.             if [[$obj repObj] import] {
  72.                 set reload 1
  73.             } else {
  74.                 wmtkwarning "$warning '[$obj label]'."
  75.                 if [[$obj repObj] isA MTContainer] {
  76.                     # reload because some underlaying
  77.                     # elements can be succeeded
  78.                     set reload 1
  79.                 }
  80.             }
  81.         }
  82.  
  83.     }
  84.  
  85.     if {$reload == 1} {
  86.         MTFileMenuProcs::reload
  87.     }
  88. }
  89.  
  90. proc MTVersionMenuProcs::overwrite {} {
  91.  
  92.     set parentObj [[.main currentObj] repObj]
  93.  
  94.     busy {
  95.         foreach obj [.main selectedObjSet] {
  96.  
  97.             if [[$obj repObj] overwrite] {
  98.                 [$obj repObj] delete
  99.                 $obj delete
  100.             }
  101.         }
  102.     }
  103.  
  104.     .main setCurrentContextVars    
  105.  
  106.     MTFileMenuProcs::reload
  107. }
  108.  
  109. proc MTVersionMenuProcs::createMergeLink {} {
  110.  
  111.     set selObjs [.main selectedObjSet]
  112.     if {[llength $selObjs] == 1} {
  113.         set selObj [lindex $selObjs 0]
  114.         set selMergeObj [$selObj repObj]
  115.         set fromName [[$selMergeObj fromRepObj] versionName]
  116.         set toName [[$selMergeObj toRepObj] versionName]
  117.         set title "Link From '$fromName' To '$toName'"
  118.     } else {
  119.         set title "Links"
  120.         foreach selObj $selObjs {
  121.             lappend selMergeObj [$selObj repObj]
  122.         }
  123.         set selObj $selObjs
  124.     }
  125.     require mtmergedia.tcl
  126.     MTMergeDialog new .main.mergeDialog
  127.     .main.mergeDialog mtVersion $selMergeObj
  128.     .main.mergeDialog title $title
  129.     .main.mergeDialog browsObject $selObj
  130.     .main.mergeDialog popUp
  131. }
  132.  
  133. proc MTVersionMenuProcs::compare {} {
  134.     require vbversionm.tcl
  135.     set selObj [lindex [.main selectedObjSet] 0]
  136.     set selMergeObj [$selObj repObj]
  137.     set version1 [$selMergeObj fromRepObj]
  138.     set version2 [$selMergeObj toRepObj]
  139.     VBVersionMenuProcs::doCompare $version1 $version2
  140. }
  141.  
  142. proc MTVersionMenuProcs::startVersionBrowser {} {
  143.     
  144.     set message "Starting Version Browser"
  145.     set curObj [[.main selectedMergeObjSet] fromRepObj]
  146.  
  147.     # Go down to obj level and start version browser
  148.     set clientContext [ClientContext::global]
  149.     set levelIds [$clientContext currentLevelIdString]
  150.  
  151.     set loopObj $curObj
  152.     set objs {}
  153.     while {[$loopObj parent] != ""} {
  154.             set loopObj [$loopObj parent]
  155.         set objs "$loopObj $objs"
  156.     }
  157.  
  158.     set curLevel [$clientContext currentLevelId]
  159.     set start 0
  160.         foreach obj $objs {
  161.         if {$obj == [$clientContext currentFile]} {
  162.             # do not add file level to clientcontext
  163.             break
  164.         }
  165.         if {$start == 1} {
  166.                 $clientContext downLevelId $obj
  167.         }
  168.         if {$obj == $curLevel} {
  169.             # start leveling down after currentLevel
  170.             set start 1
  171.         } 
  172.     }
  173.  
  174.     set id [$curObj identity]
  175.     set script "SystemUtilities::fork otk vbrowser"
  176.     set script "$script -c [list [get_comm_name]] -v $id"
  177.     set endScript ""
  178.     .main startCommand tcl "$script" "$endScript" "$message" {0 0} 0
  179.  
  180.     # Reset clientContext
  181.     $clientContext setLevelIds $levelIds
  182. }
  183.  
  184. # Do not delete this line -- regeneration end marker
  185.  
  186.