home *** CD-ROM | disk | FTP | other *** search
- #---------------------------------------------------------------------------
- #
- # (c) Cayenne Software Inc. 1997
- #
- # File: @(#)vbprocs.tcl /main/titanic/17
- # Author: <generated>
- # Description:
- #---------------------------------------------------------------------------
- # SccsId = @(#)vbprocs.tcl /main/titanic/17 28 Nov 1997 Copyright 1997 Cayenne Software Inc.
-
- # Start user added include file section
- # End user added include file section
-
-
- Class VBProcs : {Object} {
- constructor
- method destructor
- }
-
- constructor VBProcs {class this name} {
- set this [Object::constructor $class $this $name]
- # Start constructor user section
- # End constructor user section
- return $this
- }
-
- method VBProcs::destructor {this} {
- # Start destructor user section
- # End destructor user section
- }
-
- proc VBProcs::setViewMode {} {
- set arbiter [.main menuBar].view.menu.menuarbiter
- if {! [isCommand $arbiter]} return
-
- case "[$arbiter currentButton]" in {
- {0} {[.main infoView] mode ICON}
- {1} {[.main infoView] mode SMALLICON}
- {2} {[.main infoView] mode DETAIL}
- }
- m4_var set M4_infoview_mode [[.main infoView] mode] -context vbrowser
- }
-
- proc VBProcs::setViewButton {} {
- set arbiter [.main menuBar].view.menu.menuarbiter
- if {! [isCommand $arbiter]} return
-
- case "[[.main infoView] mode]" in {
- {ICON} {$arbiter currentButton 0}
- {SMALLICON} {$arbiter currentButton 1}
- {DETAIL} {$arbiter currentButton 2}
- }
- }
-
- proc VBProcs::scaleFont {font factor} {
- set sep1 [string first "-" $font]
- if {$sep1 != -1} {
- set head [string range $font 0 $sep1]
- set tail [string range $font [incr sep1] end]
- set sep2 [string first "-" $tail]
- if {$sep2 != -1} {
- append head [string range $tail 0 $sep2]
- set size [string range $tail [incr sep2] end]
- return $head[expr round($size * $factor)]
- }
- }
- return $font
- }
-
- proc VBProcs::zoom {factor} {
-
- busy {
- set area [.main infoView]
- set orgScale [$area scale]
- set scale [expr {$orgScale * $factor}]
- if {$scale < 0.1} {
- if {$orgScale < 0.1} {
- wmtkmessage "Scale factor too small, reset to 1.00"
- $area scale 1.00
- return
- }
- wmtkmessage "Minimum zoom factor reached"
- return
- }
- if {$scale > 3} {
- if {$orgScale > 3} {
- wmtkmessage "Scale factor too large, reset to 1.00"
- $area scale 1.00
- return
- }
- wmtkmessage "Maximum zoom factor reached"
- return
- }
- wmtkmessage "Scale factor is now [format %.2f $scale]"
- $area scale $scale
- }
- }
-
- proc VBProcs::takes22tango {menuEntry} {
-
- set sel [.main selectedObjSet]
- set len [llength $sel]
- if {$len != 2 && $len != 1} {
- $menuEntry sensitive 0
- } else {
- $menuEntry sensitive 1
- }
- }
-
- proc VBProcs::mustBe {status menuEntry} {
-
- require browserpro.tcl
- $menuEntry sensitive [BrowserProcs::statusObjectsAre $status]
- }
-
- proc VBProcs::mustNotBe {status menuEntry} {
-
- require browserpro.tcl
- $menuEntry sensitive [BrowserProcs::statusObjectsAreNot $status]
- }
-
- proc VBProcs::parentMustBe {status menuEntry {useCurrent 1}} {
-
- if $useCurrent {
- set parent [[.main infoView] getParentVersionObj]
- } else {
- set version [lindex [.main selectedObjSet] 0]
- if {"$version" == ""} {
- $menuEntry sensitive 0
- return
- }
- set parent [lindex [VBProcs::getOwners $version] 0]
- }
-
- if {"$parent" == ""} {
- $menuEntry sensitive 0
- return
- }
-
- if [$parent isA Project] {
- $menuEntry sensitive 1
- return
- }
-
- set objStatus [$parent getInfo Status]
- if {$objStatus == $status} {
- $menuEntry sensitive 1
- } else {
- $menuEntry sensitive 0
- }
- }
-
- proc VBProcs::id2Obj {id} {
- set class [lindex [split $id :] 0]
- set obj [$class new $id]
- }
-
- proc VBProcs::selectOther {command title {addBackGround 0}} {
-
- set primaryNode [lindex [[.main infoView] selectedSet] 0]
- set nodes [VBProcs::getChildNodes [[.main infoView] root]]
- set names {}
-
- #skip the first node (the versionable)
- set nodes [lrange $nodes 1 end]
-
- set first 1
- foreach node $nodes {
- if {[$node labelA] != [$primaryNode labelA]} {
- # check status
- if {$addBackGround == 0} {
- if {[$node state] == "B"} {
- # background
- continue
- }
- }
- # selection in ListDialog problem when adding spaces
- # (ok button stays enabled)
- #if {$first == 1 && [llength [$node labelA]] < 50} {
- # set tmp [format "%-50" "[$node labelA]"]
- # lappend names $tmp
- # set first 0
- #} else {
- lappend names [$node labelA]
- #}
- }
- }
-
- if {$names == {}} {
- wmtkinfo "There are no version(s) to select from."
- return
- }
-
- ClassMaker::extend ListDialog SelSecondDialog command
- SelSecondDialog new .main.selectSecondDialog
- if {$title == "Merge"} {
- .main.selectSecondDialog helpPressed \
- {.main helpOnName merge}
- } elseif {$title == "Compare"} {
- .main.selectSecondDialog helpPressed \
- {.main helpOnName compare}
- } elseif {$title == "MergeLink"} {
- .main.selectSecondDialog helpPressed \
- {.main helpOnName mergeLink}
- } elseif {$title == "Deleting MergeLink"} {
- .main.selectSecondDialog helpPressed \
- {.main helpOnName deleteMergeLink}
- }
- .main.selectSecondDialog entrySet $names
- .main.selectSecondDialog selectionPolicy SINGLE
- .main.selectSecondDialog command $command
- .main.selectSecondDialog title "Select Source (From) Object for $title"
- .main.selectSecondDialog okPressed {
- set selName [lindex [%this selectedSet] 0]
- if {$selName == ""} {
- return
- }
- set secondNode ""
- foreach node [VBProcs::getChildNodes [[.main infoView] root]] {
- if {[$node labelA] == $selName} {
- set secondNode $node
- break;
- }
- }
- if {$secondNode != ""} {
- $secondNode selectState 1
- .main selectionChanged
- }
-
- eval [%this command]
- }
- .main.selectSecondDialog popUp
- }
-
- proc VBProcs::getChildNodes {parentList} {
-
- set returnList {}
-
- foreach node $parentList {
- lappend returnList $node
- foreach child [VBProcs::getChildNodes [$node childSet]] {
- lappend returnList $child
- }
- }
- return $returnList
- }
-
- proc VBProcs::getOwners {version} {
- if [$version isA PhaseVersion] {
- return [osort status -decreasing [$version configVersions]]
- }
-
- if [$version isA SystemVersion] {
- return [osort status -decreasing [$version phaseVersions]]
- }
-
- if [$version isA FileVersion] {
- return [osort status -decreasing [$version systemVersions]]
- }
-
- if [$version isA GroupVersion] {
- return [osort status -decreasing [$version systemVersions]]
- }
-
- if [$version isA CustomFileVersion] {
- set customLevelVersions [$version customLevelVersions]
- if [[[$version customFile] customLevel] isA Project] {
- return $customLevelVersions
- }
- return [osort status -decreasing $customLevelVersions]
- }
-
- return ""
- }
-
- proc VBProcs::levelIds {version} {
- set owners ""
- for {set owner $version} \
- {[isCommand $owner]} \
- {set owner [lindex [VBProcs::getOwners $owner] 0]} {
- set owners [linsert $owners 0 $owner]
- }
-
- set cc [ClientContext::global]
- set corp [$cc currentCorporate]
- set levelIds "/[$corp identity]"
- set proj [$cc currentProject]
- append levelIds "/[$proj identity]"
- foreach owner $owners {
- append levelIds "/[$owner identity]"
- }
- return $levelIds
- }
-
- proc VBProcs::showHelpOnContext {} {
- .main helpOnName versionBrowser
- }
-
- # Do not delete this line -- regeneration end marker
-
-