home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / vbprocs.tcl < prev    next >
Text File  |  1997-11-28  |  8KB  |  301 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)vbprocs.tcl    /main/titanic/17
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)vbprocs.tcl    /main/titanic/17   28 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 VBProcs : {Object} {
  16.     constructor
  17.     method destructor
  18. }
  19.  
  20. constructor VBProcs {class this name} {
  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 VBProcs::destructor {this} {
  28.     # Start destructor user section
  29.     # End destructor user section
  30. }
  31.  
  32. proc VBProcs::setViewMode {} {
  33.     set arbiter [.main menuBar].view.menu.menuarbiter
  34.     if {! [isCommand $arbiter]} return
  35.  
  36.     case "[$arbiter currentButton]" in {
  37.     {0} {[.main infoView] mode ICON}
  38.     {1} {[.main infoView] mode SMALLICON}
  39.     {2} {[.main infoView] mode DETAIL}
  40.     }
  41.     m4_var set M4_infoview_mode [[.main infoView] mode] -context vbrowser
  42. }
  43.  
  44. proc VBProcs::setViewButton {} {
  45.     set arbiter [.main menuBar].view.menu.menuarbiter
  46.     if {! [isCommand $arbiter]} return
  47.  
  48.     case "[[.main infoView] mode]" in {
  49.     {ICON}        {$arbiter currentButton 0}
  50.     {SMALLICON} {$arbiter currentButton 1}
  51.     {DETAIL}    {$arbiter currentButton 2}
  52.     }
  53. }
  54.  
  55. proc VBProcs::scaleFont {font factor} {
  56.     set sep1 [string first "-" $font]
  57.     if {$sep1 != -1} {
  58.         set head [string range $font 0 $sep1]
  59.         set tail [string range $font [incr sep1] end]
  60.         set sep2 [string first "-" $tail]
  61.         if {$sep2 != -1} {
  62.             append head [string range $tail 0 $sep2]
  63.             set size [string range $tail [incr sep2] end]
  64.             return $head[expr round($size * $factor)]
  65.         }
  66.     }
  67.     return $font
  68. }
  69.  
  70. proc VBProcs::zoom {factor} {
  71.  
  72.     busy {
  73.         set area [.main infoView]
  74.         set orgScale [$area scale]
  75.         set scale [expr {$orgScale * $factor}]
  76.         if {$scale < 0.1} {
  77.             if {$orgScale < 0.1} {
  78.                  wmtkmessage "Scale factor too small, reset to 1.00"
  79.                  $area scale 1.00
  80.                  return
  81.             }
  82.             wmtkmessage "Minimum zoom factor reached"
  83.             return
  84.         }
  85.         if {$scale > 3} {
  86.             if {$orgScale > 3} {
  87.                  wmtkmessage "Scale factor too large, reset to 1.00"
  88.                  $area scale 1.00
  89.                  return
  90.             }
  91.             wmtkmessage "Maximum zoom factor reached"
  92.             return
  93.         }
  94.         wmtkmessage "Scale factor is now [format %.2f $scale]"
  95.         $area scale $scale
  96.     }
  97. }
  98.  
  99. proc VBProcs::takes22tango {menuEntry} {
  100.  
  101.     set sel [.main selectedObjSet]
  102.     set len [llength $sel]
  103.     if {$len != 2 && $len != 1} {
  104.         $menuEntry sensitive 0
  105.     } else {
  106.         $menuEntry sensitive 1
  107.     }
  108. }
  109.  
  110. proc VBProcs::mustBe {status menuEntry} {
  111.  
  112.     require browserpro.tcl
  113.     $menuEntry sensitive [BrowserProcs::statusObjectsAre $status]
  114. }
  115.  
  116. proc VBProcs::mustNotBe {status menuEntry} {
  117.  
  118.     require browserpro.tcl
  119.     $menuEntry sensitive [BrowserProcs::statusObjectsAreNot $status]
  120. }
  121.  
  122. proc VBProcs::parentMustBe {status menuEntry {useCurrent 1}} {
  123.  
  124.     if $useCurrent {
  125.         set parent [[.main infoView] getParentVersionObj]
  126.     } else {
  127.         set version [lindex [.main selectedObjSet] 0]
  128.         if {"$version" == ""} {
  129.             $menuEntry sensitive 0
  130.             return
  131.         }
  132.         set parent [lindex [VBProcs::getOwners $version] 0]
  133.     }
  134.  
  135.     if {"$parent" == ""} {
  136.         $menuEntry sensitive 0
  137.         return
  138.     }
  139.  
  140.     if [$parent isA Project] {
  141.         $menuEntry sensitive 1
  142.         return
  143.     }
  144.  
  145.     set objStatus [$parent getInfo Status]
  146.     if {$objStatus == $status} {
  147.         $menuEntry sensitive 1
  148.     } else {
  149.         $menuEntry sensitive 0
  150.     }
  151. }
  152.  
  153. proc VBProcs::id2Obj {id} {
  154.     set class [lindex [split $id :] 0]
  155.     set obj [$class new $id]
  156. }
  157.  
  158. proc VBProcs::selectOther {command title {addBackGround 0}} {
  159.  
  160.     set primaryNode [lindex [[.main infoView] selectedSet] 0]
  161.     set nodes [VBProcs::getChildNodes [[.main infoView] root]]
  162.     set names {}
  163.  
  164.     #skip the first node (the versionable)
  165.     set nodes [lrange $nodes 1 end]
  166.  
  167.     set first 1
  168.     foreach node $nodes {
  169.         if {[$node labelA] != [$primaryNode labelA]} {
  170.             # check status
  171.             if {$addBackGround == 0} {
  172.                 if {[$node state] == "B"} {
  173.                     # background
  174.                     continue
  175.                 }
  176.             }
  177.             # selection in ListDialog problem when adding spaces
  178.             # (ok button stays enabled)
  179.             #if {$first == 1 && [llength [$node labelA]] < 50} {
  180.             #    set tmp [format "%-50" "[$node labelA]"]
  181.             #    lappend names $tmp
  182.             #    set first 0
  183.             #} else {
  184.                 lappend names [$node labelA]
  185.             #}
  186.         }
  187.     }
  188.  
  189.     if {$names == {}} {
  190.         wmtkinfo "There are no version(s) to select from."
  191.         return
  192.     }
  193.  
  194.     ClassMaker::extend ListDialog SelSecondDialog command
  195.     SelSecondDialog new .main.selectSecondDialog
  196.     if {$title == "Merge"} {
  197.         .main.selectSecondDialog helpPressed \
  198.             {.main helpOnName merge}
  199.     } elseif {$title == "Compare"} {
  200.         .main.selectSecondDialog helpPressed \
  201.             {.main helpOnName compare}
  202.     } elseif {$title == "MergeLink"} {
  203.         .main.selectSecondDialog helpPressed \
  204.             {.main helpOnName mergeLink}
  205.     } elseif {$title == "Deleting MergeLink"} {
  206.         .main.selectSecondDialog helpPressed \
  207.             {.main helpOnName deleteMergeLink}
  208.     }
  209.     .main.selectSecondDialog entrySet $names
  210.     .main.selectSecondDialog selectionPolicy SINGLE
  211.     .main.selectSecondDialog command $command
  212.     .main.selectSecondDialog title "Select Source (From) Object for $title"
  213.     .main.selectSecondDialog okPressed {
  214.         set selName [lindex [%this selectedSet] 0]
  215.         if {$selName == ""} {
  216.             return
  217.         }
  218.         set secondNode ""
  219.         foreach node [VBProcs::getChildNodes [[.main infoView] root]] {
  220.             if {[$node labelA] == $selName} {
  221.                 set secondNode $node
  222.                 break;
  223.             }
  224.         }
  225.         if {$secondNode != ""} {
  226.             $secondNode selectState 1
  227.             .main selectionChanged
  228.         }
  229.  
  230.         eval [%this command]
  231.     }
  232.     .main.selectSecondDialog popUp
  233. }
  234.  
  235. proc VBProcs::getChildNodes {parentList} {
  236.  
  237.     set returnList {}
  238.  
  239.     foreach node $parentList {
  240.         lappend returnList $node
  241.         foreach child [VBProcs::getChildNodes [$node childSet]] {
  242.             lappend returnList $child
  243.         }
  244.     }
  245.     return $returnList
  246. }
  247.  
  248. proc VBProcs::getOwners {version} {
  249.     if [$version isA PhaseVersion] {
  250.     return [osort status -decreasing [$version configVersions]]
  251.     }
  252.  
  253.     if [$version isA SystemVersion] {
  254.     return [osort status -decreasing [$version phaseVersions]]
  255.     }
  256.  
  257.     if [$version isA FileVersion] {
  258.     return [osort status -decreasing [$version systemVersions]]
  259.     }
  260.  
  261.     if [$version isA GroupVersion] {
  262.     return [osort status -decreasing [$version systemVersions]]
  263.     }
  264.  
  265.     if [$version isA CustomFileVersion] {
  266.     set customLevelVersions [$version customLevelVersions]
  267.     if [[[$version customFile] customLevel] isA Project] {
  268.         return $customLevelVersions
  269.     }
  270.     return [osort status -decreasing $customLevelVersions]
  271.     }
  272.  
  273.     return ""
  274. }
  275.  
  276. proc VBProcs::levelIds {version} {
  277.     set owners ""
  278.     for {set owner $version} \
  279.     {[isCommand $owner]} \
  280.     {set owner [lindex [VBProcs::getOwners $owner] 0]} {
  281.     set owners [linsert $owners 0 $owner]
  282.     }
  283.  
  284.     set cc [ClientContext::global]
  285.     set corp [$cc currentCorporate]
  286.     set levelIds "/[$corp identity]"
  287.     set proj [$cc currentProject]
  288.     append levelIds "/[$proj identity]"
  289.     foreach owner $owners {
  290.     append levelIds "/[$owner identity]"
  291.     }
  292.     return $levelIds
  293. }
  294.  
  295. proc VBProcs::showHelpOnContext {} {
  296.     .main helpOnName versionBrowser
  297. }
  298.  
  299. # Do not delete this line -- regeneration end marker
  300.  
  301.