home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / mtversion.tcl < prev    next >
Encoding:
Text File  |  1997-11-26  |  9.9 KB  |  422 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)mtversion.tcl    /main/titanic/19
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)mtversion.tcl    /main/titanic/19   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. require "mergeobjec.tcl"
  15.  
  16. Class MTVersion : {MergeObject} {
  17.     constructor
  18.     method destructor
  19.     method hasConflict
  20.     method initializeInfo
  21.     method getInfo
  22.     method merge
  23.     method import
  24.     method select
  25.     method getBaseVersion
  26.     method createConflictingObjects
  27.     method overwrite
  28.     method getOwners
  29.     method findToObject
  30.     method getVersionableClass
  31.     method setVersionableClass
  32.     method removeVersionableClass
  33.     attribute selectFlag
  34.     attribute level
  35.     attribute toChanged
  36.     attribute fromIsDerived
  37.     attribute toIsDerived
  38.     attribute copyCommand
  39.     attribute versionableClass
  40. }
  41.  
  42. constructor MTVersion {class this name fromRepObj toRepObj} {
  43.     set this [MergeObject::constructor $class $this $name $fromRepObj $toRepObj]
  44.     $this toChanged 0
  45.     $this fromIsDerived 0
  46.     $this toIsDerived 0
  47.     $this versionableClass [Dictionary new]
  48.     # Start constructor user section
  49.     # valid for every version
  50.     $this setVersionableClass customFileVersions MTCustFile
  51.     $this baseRepObj [$this getBaseVersion]
  52.  
  53.     if {$toRepObj != "" && $toRepObj != $fromRepObj} {
  54.         # check if 'fromRepObj' is derived from 'toRepObj'
  55.         for {set v $fromRepObj} {!["$v" isNil]} \
  56.             {set v [$v baseVersion]} {
  57.             if {$v == $toRepObj} {
  58.                 $this fromIsDerived 1
  59.             }
  60.         }
  61.  
  62.         # check if 'toRepObj' is derived from 'fromRepObj'
  63.         for {set v $toRepObj} {!["$v" isNil]} \
  64.             {set v [$v baseVersion]} {
  65.             if {$v == $fromRepObj} {
  66.                 $this toIsDerived 1
  67.             }
  68.         }
  69.     }
  70.     # End constructor user section
  71.     return $this
  72. }
  73.  
  74. method MTVersion::destructor {this} {
  75.     # Start destructor user section
  76.     # End destructor user section
  77.     $this MergeObject::destructor
  78. }
  79.  
  80. method MTVersion::hasConflict {this} {
  81.  
  82.     set to [$this toRepObj]
  83.     set fr [$this fromRepObj]
  84.  
  85.     # check if 'to' element does not exist
  86.     if {$to == ""} {
  87.         return 0
  88.     }
  89.  
  90.     if [[$this fromRepObj] isA CustomLevelVersion] {
  91.         if [[$this childSet] empty] {
  92.             # no children, even if the versions are conflicting
  93.             # the version can be merged
  94.             return 0
  95.         }
  96.     }
  97.  
  98.     if [[$this fromRepObj] isA CustomLevelVersion] {
  99.         set conflict 0
  100.         [$this childSet] foreach child {
  101.             if [$child hasConflict] {
  102.                 set conflict 1
  103.             }
  104.         }
  105.         if {$conflict == 0} {
  106.             # no conflicting children, even if the versions
  107.             # are conflicting the version can be merged
  108.             return 0
  109.         }
  110.     }
  111.  
  112.     # when importing versions there's always a conflict
  113.     # because it can not determined whether it is different or not.
  114.     # because the objects are from different object trees
  115.     # (mergelinked elements are not shown at all)
  116.     if [.main import] {
  117.         return 1
  118.     }
  119.  
  120.     if {[$this fromIsDerived] || [$this toIsDerived]} {
  121.         return 0
  122.     }
  123.  
  124.     # now it's clear there's a conflict
  125.     return 1
  126. }
  127.  
  128. method MTVersion::initializeInfo {this} {
  129.  
  130.     set fromVersion [$this fromRepObj]
  131.     BrowserProcs::initializeInfo $fromVersion $fromVersion
  132. }
  133.  
  134. method MTVersion::getInfo {this} {
  135.  
  136.     set owners [$this getOwners]
  137.     set fromOwners [lindex $owners 0]
  138.     set toOwners [lindex $owners 1]
  139.  
  140.     set info ""
  141.  
  142.     set configs ""
  143.     foreach owner $fromOwners {
  144.         if {$configs != ""} {
  145.             append configs "\n"
  146.         }
  147.         append configs "- [$owner status] [$owner text]"
  148.     }
  149.  
  150.     if {$configs != ""} {
  151.         lappend info  "From Selected In"
  152.         lappend info $configs
  153.     }
  154.  
  155.     set configs ""
  156.     foreach owner $toOwners {
  157.         if {$configs != ""} {
  158.             append configs "\n"
  159.         }
  160.         append configs "- [$owner status] [$owner text]"
  161.     }
  162.  
  163.     if {$configs != ""} {
  164.         lappend info  "To Selected In"
  165.         lappend info $configs
  166.     }
  167.  
  168.     return $info
  169. }
  170.  
  171. method MTVersion::merge {this} {
  172.  
  173.     set name [[$this fromRepObj] getInfo Name]
  174.     set type [[$this fromRepObj] getInfo Type]
  175.     wmtkmessage "Merging object $name.$type"
  176.     set success 1
  177.     set warning "Cannot merge object, "
  178.     set warning "$warning parent object does not exist in 'to' version."
  179.  
  180.     # if no conflict AND there's added in the 'to' version
  181.     if {![$this hasConflict] && ![$this toChanged]} {
  182.         if ![[$this parent] hasConflict] {
  183.             if {[[$this parent] toRepObj] == ""} {
  184.                 wmtkwarning $warning
  185.                 return 0
  186.             }
  187.         }
  188.  
  189.         if {[$this isA MTContainer] && ![$this fromIsDerived] &&
  190.             [$this toRepObj] != ""} {
  191.             set comment [.main mergeLinkComment]
  192.         } else {
  193.             $this select
  194.             return 1
  195.         }
  196.     }
  197.  
  198.     # merge all the children, skip the conflicting ones
  199.     # if no children left, create a merge link
  200.     if {![$this isA MTContainer]} {
  201.         # only merge links if container
  202.         # a file is not a container
  203.         set success 0
  204.     } else {
  205.         [$this childSet] foreach child {
  206.             if ![$child merge] {
  207.                 set success 0
  208.             }
  209.         }
  210.     }
  211.  
  212.     if {$success == 1} {
  213.         # only merge link if different versions
  214.         if {[$this toRepObj] != [$this fromRepObj]} {
  215.             set comment [.main mergeLinkComment]
  216.             MTProcs::createMergeLink $this $comment
  217.         }
  218.     }
  219.  
  220.     wmtkmessage ""
  221.     return $success
  222. }
  223.  
  224. method MTVersion::import {this} {
  225.  
  226.     set name [[$this fromRepObj] getInfo Name]
  227.     set type [[$this fromRepObj] getInfo Type]
  228.     wmtkmessage "Merging object $name.$type"
  229.  
  230.     # import the file
  231.     if {[$this toRepObj] != ""} {
  232.         MTProcs::makeToWorking $this
  233.     } else {
  234.         if {[$this parent] != "" && [[$this parent] toRepObj] != ""} {
  235.             MTProcs::makeToWorking [$this parent]
  236.         } else {
  237.             set warning "Cannot merge object, parent object does"
  238.             set warning "$warning not exist in 'to' version."
  239.             wmtkwarning $warning
  240.             wmtkmessage ""
  241.             return 0
  242.         }
  243.     }
  244.     set toSys [[$this parent] toRepObj]
  245.     set fromObj [$this fromRepObj]
  246.     set fromConfig [.main fromConfig]
  247.     set copyCmd [$this copyCommand]
  248.     if [$fromObj isA GroupVersion] {
  249.         set fromSys [[$this parent] fromRepObj]
  250.         set toConfig [.main toConfig]
  251.         set groupName [$fromObj name]
  252.         set cmd "$toSys $copyCmd $fromObj $fromSys $fromConfig \
  253.         $toConfig definition"
  254.         eval $cmd
  255.         # search for the copied GropVersion
  256.         set to [$toSys findGroupVersion $groupName]
  257.     } elseif [$fromObj isA CustomFileVersion] {
  258.         set cmd "$toSys $copyCmd $fromObj"
  259.         set to [eval $cmd]
  260.     } else {
  261.         set cmd "$toSys $copyCmd $fromObj $fromConfig"
  262.         set to [eval $cmd]
  263.     }
  264.     $this toRepObj $to
  265.  
  266.     # create mergelink
  267.     MTProcs::createMergeLink $this [.main mergeLinkComment]
  268.  
  269.     wmtkmessage ""
  270.     return 1
  271. }
  272.  
  273. method MTVersion::select {this} {
  274.  
  275.     MTProcs::freeze [$this fromRepObj] [.main freezeComment]
  276.  
  277.     set parentObj [[$this parent] toRepObj]
  278.     set selectFlag [$this selectFlag]
  279.  
  280.     set parentObj [MTProcs::makeToWorking [$this parent]]
  281.     if {$parentObj == ""} {
  282.         return 0
  283.     }
  284.  
  285.     if [[$this fromRepObj] isA CustomFileVersion] {
  286.         $parentObj select [$this fromRepObj]
  287.     } else {
  288.         $parentObj select -$selectFlag [$this fromRepObj] \
  289.             [[$this fromRepObj] linkStatus]
  290.     }
  291.  
  292.     # update rep information
  293.     $this toRepObj [$this fromRepObj]
  294.     return 1
  295. }
  296.  
  297. method MTVersion::getBaseVersion {this} {
  298.  
  299.     if {[$this toRepObj] == ""} {
  300.         return ""
  301.     }
  302.     set base [[$this fromRepObj] commonBaseVersion [$this toRepObj]]
  303.     if [$base isNil] {
  304.         return ""
  305.     }
  306.     return $base
  307. }
  308.  
  309. method MTVersion::createConflictingObjects {this} {
  310.  
  311.     global classCount
  312.  
  313.     foreach assoc [$this associations] {
  314.  
  315.         set fromVersions [[$this fromRepObj] $assoc]
  316.         if {[$this toRepObj] != ""} {
  317.             set toVersions [[$this toRepObj] $assoc]
  318.         } else {
  319.             set toVersions ""
  320.         }
  321.         foreach fromVersion $fromVersions {
  322.  
  323.             if [.main import] {
  324.                 set toVersion [MTProcs::needImport \
  325.                     $fromVersion $this]
  326.             } else {
  327.                 set toVersion [MTProcs::needMerge \
  328.                     $fromVersion $toVersions]
  329.             }
  330.  
  331.             if {$toVersion == "ok"} {
  332.                 continue
  333.             }
  334.  
  335.             incr classCount
  336.             set obj MTVersion$classCount
  337.  
  338.             set class [$this getVersionableClass $assoc]
  339.             if {$class == ""} {
  340.                 # no class, it is not a versionable
  341.                 continue
  342.             }
  343.             $class new $obj $fromVersion $toVersion
  344.             $this addChild $obj
  345.             $fromVersion parent [$this fromRepObj]
  346.             if [isCommand $toVersion] {
  347.                 $toVersion parent [$this toRepObj]
  348.             }
  349.         }
  350.  
  351.         # now check if the 'to' version is changed (added to)
  352.         foreach toVersion $toVersions {
  353.  
  354.             if ![isCommand [MTProcs::findToObject $toVersion \
  355.                 $fromVersions]] {
  356.                 # stuff is added
  357.                 $this toChanged 1
  358.             }
  359.         }
  360.     }
  361.  
  362.     if {[$this toRepObj] == ""} {
  363.         return
  364.     }
  365.  
  366.     set diffsList [[$this toRepObj] propertyDiffs [$this fromRepObj] \
  367.         [$this baseRepObj]]
  368.     foreach diffs $diffsList {
  369.         set from ""
  370.         if ![[lindex $diffs 0] isNil] {
  371.             set from [lindex $diffs 0]
  372.             MTPropRepObj promote $from
  373.             $from setInfo PropertyName [$from name]
  374.             $from setInfo Name [[$this fromRepObj] getInfo Name]
  375.             $from setInfo Type [[$this fromRepObj] getInfo Type]
  376.         }
  377.         set to [lindex $diffs 1]
  378.         if [$to isNil] {
  379.             set to ""
  380.         }
  381.  
  382.         if {$to != ""} {
  383.             MTPropRepObj promote $to
  384.             $to setInfo PropertyName [$to name]
  385.             $to setInfo Name [[$this toRepObj] getInfo Name]
  386.             $to setInfo Type [[$this toRepObj] getInfo Type]
  387.         }
  388.         incr classCount
  389.         set obj MTVersion$classCount
  390.         MTProperty new $obj $from $to
  391.         $this addChild $obj
  392.     }
  393. }
  394.  
  395. method MTVersion::overwrite {this} {
  396.  
  397.     return [$this select]
  398. }
  399.  
  400. method MTVersion::getOwners {this} {
  401.     return {{} {}}
  402. }
  403.  
  404. method MTVersion::findToObject {this} {
  405.     return ""
  406. }
  407.  
  408. # Do not delete this line -- regeneration end marker
  409.  
  410. method MTVersion::getVersionableClass {this association} {
  411.     return [[$this versionableClass] set $association]
  412. }
  413.  
  414. method MTVersion::setVersionableClass {this association newVersionableClass} {
  415.     [$this versionableClass] set $association $newVersionableClass
  416. }
  417.  
  418. method MTVersion::removeVersionableClass {this association} {
  419.     [$this versionableClass] unset $association
  420. }
  421.  
  422.