home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World 1997 November
/
PCWorld_1997-11_cd.bin
/
software
/
programy
/
komix
/
DATA.Z
/
commonbrow.tcl
< prev
next >
Wrap
Text File
|
1996-12-05
|
20KB
|
757 lines
#---------------------------------------------------------------------------
#
# (c) Cayenne Software Inc. 1996
#
# File: @(#)commonbrow.tcl /main/hindenburg/23
# Author: <generated>
# Description:
#---------------------------------------------------------------------------
# SccsId = @(#)commonbrow.tcl /main/hindenburg/23 5 Dec 1996 Copyright 1996 Cayenne Software Inc.
# Start user added include file section
require "browserobj.tcl"
require "browserpro.tcl"
require "browsewmta.tcl"
require "filterhand.tcl"
require "infoview.tcl"
require "m4vardescr.tcl"
require "navigation.tcl"
require "treenode.tcl"
# End user added include file section
require "wmttool.tcl"
Class CommonBrowser : {WmtTool MainWindow} {
method destructor
constructor
method createInterface
method addFileHistory
method historyActivated
method findTreeNode
method abbrevLevelPath
method renumberFileHistory
method setFileHistory
method saveFileHistory
method addContextArea
method updateToolBar
method updateWmtArea
method createPropContainers
method releasePropContainers
method setCurrentObj
method getSelectedSet
method selectionChanged
method open
method popUp
method stop
method updateTitle
method undoCommandBusy
method editCut
method editCopy
method editPaste
method editSelAll
method editDeselAll
method editSelInv
method editUndo
method addPropContainer
method removePropContainer
attribute currentObj
attribute corporateObj
attribute rootIdList
attribute viewSelector
attribute historyCount
attribute opened
attribute moduleHdlr
attribute filterHdlr
attribute objectHdlr
attribute viewHdlr
attribute menuHdlr
attribute wmtArea
attribute navigationView
attribute infoView
attribute m4VarDes
attribute propContainerSet
attribute undoCommand
attribute fileHistorySet
}
method CommonBrowser::destructor {this} {
# Start destructor user section
if [$this opened] {
$this saveFileHistory
$this saveToolBarPresence desk
$this saveContextAreaPresence desk
$this saveMessageAreaPresence desk
}
catch {
if [isCommand [$this undoCommand]] {
[$this undoCommand] delete
}
[$this filterHdlr] delete
[$this menuHdlr] delete
[$this viewHdlr] delete
[$this objectHdlr] delete
}
# End destructor user section
$this WmtTool::destructor
}
constructor CommonBrowser {class this name toolId} {
set this [MainWindow::constructor $class $this $name]
set this [WmtTool::constructor $class $this $name]
$this config \
-historyCount 0 -fileHistorySet [List new] \
-opened 0
global classCount
set classCount 0
$this m4VarDes [M4VarDescription new $this.m4VarDes]
MenuBar new $this.MB
$this menuHdlr [CustBrMenuHandler new $toolId]
$this createInterface
$this viewHdlr [CustViewHandler new $toolId]
$this objectHdlr [CustObjHandler new]
$this filterHdlr [FilterHandler new $this.filterHdlr]
# Check if handlers are created without errors:
# the corporate customization files exist
if [isCommand .main.error] {
return $this
}
# Go back to corporate level and initialize the interface (toolbar)
set clientContext [ClientContext::global]
set levelIds [$clientContext currentLevelIdString]
while {! [[$clientContext currentProject] isNil]} {
$clientContext upLevel
}
[$this menuHdlr] setCurrentContext
if [catch {[$this objectHdlr] setCurrentContext} msg] {
wmtkerror $msg
}
if [catch {[$this viewHdlr] setCurrentContext} msg] {
wmtkerror $msg
}
# Reset clientContext
$clientContext setLevelIds $levelIds
m4_var foreach m4var {
if [m4_var saveStatus $m4var] {
m4_var saveStatus $m4var 0
}
}
ClassMaker::extend CustMenuPushButton HistMenuButton {treeNode levelPath}
$this setFileHistory
return $this
}
method CommonBrowser::createInterface {this} {
DlgColumn new $this.DC
$this setContextAreaPresence desk
interface VerSplitter $this.DC.VS {
NavigationView navigBT {
rowCount 5
horStretchFactor 5
verStretchFactor 5
horShrinkFactor 5
verShrinkFactor 5
}
InfoView infoIV {}
}
$this setToolBarPresence desk
$this setMessageAreaPresence desk
$this navigationView $this.DC.VS.navigBT
$this infoView $this.DC.VS.infoIV
}
method CommonBrowser::addFileHistory {this treeNode levelPath} {
if {! [isCommand [$this exitButton]]} {
return
}
set index [expr [[$this exitButton] index] - 1 - \
[[$this fileHistorySet] length]]
[$this fileHistorySet] foreach entry {
if {$levelPath != [$entry levelPath]} {
continue
}
[$this fileHistorySet] removeValue $entry
[$this fileHistorySet] insert $entry
$this renumberFileHistory
$entry index $index
return
}
set latest [expr [$this historyCount] + 1]
HistMenuButton new [$this menuBar].file.menu.his$latest \
-treeNode $treeNode -levelPath $levelPath -index $index \
-label "1 [$this abbrevLevelPath $levelPath]" -mnemonic 1 \
-hintText "Opens $levelPath." -activated "$this historyActivated %this"
[$this fileHistorySet] insert [$this menuBar].file.menu.his$latest
$this historyCount $latest
$this renumberFileHistory
if {[[$this fileHistorySet] length] > 5} {
[[$this fileHistorySet] index end] delete
[$this fileHistorySet] remove end
}
}
method CommonBrowser::historyActivated {this entry} {
if {![isCommand [$entry treeNode]]} {
$entry treeNode [$this findTreeNode [$entry levelPath]]
}
if [isCommand [$entry treeNode]] {
[$entry treeNode] open
} else {
wmtkerror "Can not open [$entry levelPath]: no such object"
[$this fileHistorySet] removeValue $entry
$this renumberFileHistory
$entry delete
}
}
method CommonBrowser::findTreeNode {this levelPath} {
set treeNode ""
append levelPath "/"
for {set count 0; set slash [string first "/" $levelPath]} \
{$slash >= 0} \
{incr count; set slash [string first "/" $levelPath]} {
if {$slash != 0} {
set level [string range $levelPath 0 [expr $slash - 1]]
if {"$treeNode" == ""} {
set childSet [[$this treeView] rootSet]
} else {
$treeNode appendChildren
set childSet [$treeNode childSet]
}
set found 0
foreach childNode $childSet {
set childObj [$childNode browsUiObj]
if {!([$childObj isA CustomLevelVersion] ||
[$childObj isA FileVersion])} continue
set childLabel [$childObj getInfo Name]
case $count in {
3 {
# ConfigVersion
append childLabel ":[$childObj getInfo Version]"
}
{4 6} {
# PhaseVersion or FileVersion
append childLabel ".[$childObj getInfo Type]"
}
5 {
# SystemVersion
append childLabel ".[[$childObj system] type]"
}
}
if {"$level" == "$childLabel"} {
set found 1
break
}
}
if {!$found} break
set treeNode $childNode
}
set levelPath [string range $levelPath [expr $slash + 1] end]
}
if {"$levelPath" == ""} {
return $treeNode
}
return ""
}
method CommonBrowser::abbrevLevelPath {this levelPath} {
set shortPath ""
append levelPath "/"
for {set count 0; set slash [string first "/" $levelPath]} \
{$slash >= 0} \
{incr count; set slash [string first "/" $levelPath]} {
if {$slash != 0} {
set sep ""
set part2 ""
set level [string range $levelPath 0 [expr $slash - 1]]
if {$count != 2} {
append shortPath "/"
}
case $count in {
1 {
# Corporate: leave out
set part1 ""
}
{2 3} {
# Project and ConfigVersion
set part1 $level
}
default {
# Typed object
set sep "."
}
}
if {$sep != ""} {
set sepPos [string last $sep $level]
if {$sepPos < 0} {
set sep ""
} else {
set part1 [string range $level 0 [expr $sepPos - 1]]
if {$count == 4} {
# Do not show type of Phase
set sep ""
} else {
set part2 [string range $level [expr $sepPos + 1] end]
}
}
}
if {[string length $part2] > 3} {
set part2 [string range $part2 0 2]
}
append shortPath ${part1}${sep}$part2
}
set levelPath [string range $levelPath [expr $slash + 1] end]
}
set maxlen 32
set plen [string length $shortPath]
if {$count < 5 || $plen <= $maxlen} {
return $shortPath
}
set lvlLen ""
set lvlSet [split $shortPath /]
foreach level $lvlSet {
lappend lvlLen [expr [string length $level] + 1]
}
set llast [expr [llength $lvlSet] - 1]
set minlb 2
set minhb [expr $llast - 1]
set minav [expr $maxlen - 6 - [lindex $lvlLen 1] - [lindex $lvlLen $llast]]
if {$minav > 0} {
for {set lb 2} {$lb < $llast} {incr lb} {
set avail [expr $maxlen - $plen - 4]
for {set hb $lb} {$hb < $llast} {incr hb} {
incr avail [lindex $lvlLen $hb]
if {$avail > -1} {
if {$avail < $minav} {
set minlb $lb
set minhb $hb
set minav $avail
}
break
}
}
}
}
set lvlSet [lreplace $lvlSet $minlb $minhb ...]
return [join $lvlSet /]
}
method CommonBrowser::renumberFileHistory {this} {
set m 1
[$this fileHistorySet] foreach entry {
$entry config \
-label "$m [$this abbrevLevelPath [$entry levelPath]]" -mnemonic $m
incr m
}
}
method CommonBrowser::setFileHistory {this} {
set history [m4_var get M4_file_history -context desk]
if {"$history" == ""} {
return
}
foreach levelPath $history {
$this addFileHistory "" $levelPath
}
}
method CommonBrowser::saveFileHistory {this} {
set history ""
[$this fileHistorySet] foreach entry {
set history [linsert $history 0 [$entry levelPath]]
}
if {$history != [m4_var get M4_file_history -context desk]} {
m4_var set M4_file_history $history -context desk
}
}
method CommonBrowser::addContextArea {this} {
$this wmtArea [BrowseWmtArea new $this.DC.WA]
}
method CommonBrowser::updateToolBar {this} {
if [catch {[$this menuHdlr] setCurrentContext} errorMsg] {
if [info exists errorInfo] {
set errorTrace $errorInfo
set errorCodeCopy $errorCode
resetErrorVars
} else {
set errorTrace ""
set errorCodeCopy ""
}
} else {
set errorMsg ""
}
[$this infoView] updateToolBarEntries
if {"$errorMsg" != ""} {
global errorInfo errorCode
set errorInfo $errorTrace
set errorCode $errorCodeCopy
wmtkerror $errorMsg
}
}
method CommonBrowser::updateWmtArea {this} {
if {! [isCommand [$this wmtArea]]} {
return
}
[$this wmtArea] updateContextInfo
[$this wmtArea] updateViewInfo
[$this wmtArea] updateFilterIndicator
}
method CommonBrowser::createPropContainers {this edit} {
require "propstruct.tcl"
require "wbpropcont.tcl"
set selectedObjSet [$this selectedObjSet]
if [lempty $selectedObjSet] {
if {"[[$this treeView] selected]" != ""} {
set treeNode [[$this treeView] selected]
} else {
set treeNode [$this currentObj]
}
if [isCommand $treeNode] {
if [[$treeNode browsUiObj] isA PropertyObject] {
lappend selectedObjSet [$treeNode browsUiObj]
} else {
lappend selectedObjSet [$treeNode getParent PropertyObject]
}
} else {
lappend selectedObjSet [$this corporateObj]
}
}
set maxNameLength 0
set propStructList [List new]
foreach obj $selectedObjSet {
set objType [$obj browserType]
set phaseType ""
set phaseV [$obj getParent PhaseVersion]
if {"$phaseV" != ""} {
set phaseType [[$phaseV phase] type]
}
PropLocation new .propLocation \
-containerKind [$obj uiClass] \
-containerType $objType \
-phaseType $phaseType
set compPropDefs [[$this propKnowledgeDB] definitions .propLocation]
if {[llength $compPropDefs] == 0} {
.propLocation delete
continue
}
set objName [$obj getInfo Name]
set objNameLength [string length $objName]
if {$objNameLength > $maxNameLength} {
set maxNameLength $objNameLength
}
$propStructList append [PropStruct new \
-name $objName \
-type $objType \
-component $obj \
-containerKey [.propLocation asString] \
-compPropDefs $compPropDefs]
.propLocation delete
}
set formatString "%-*.*s %s"
set cntList [List new]
$propStructList foreach propStruct {
set pres [format $formatString $maxNameLength $maxNameLength \
[$propStruct name] [$propStruct type]]
set cnt [WbPropContainer new \
-editable $edit \
-propertyKey [$propStruct containerKey] \
-propertyPresentation $pres \
-propHolder [$propStruct component]]
foreach propDef [$propStruct compPropDefs] {
$cnt addPropDefinition $propDef
}
$cntList append $cnt
}
$this propContainerSet $cntList
}
method CommonBrowser::releasePropContainers {this} {
# empty
}
method CommonBrowser::setCurrentObj {this newObject} {
set errorStack ""
if {! [isCommand $newObject]} {
set rootObject [lindex [[$this treeView] rootSet] 0]
if {! [isCommand $rootObject]} {
return $errorStack
}
set newObject $rootObject
}
set currentObj [$this currentObj]
if {$currentObj == $newObject} {
return $errorStack
}
if {[isCommand $currentObj] &&
[$currentObj browsUiObj] == [$newObject browsUiObj]} {
$this currentObj $newObject
$this updateView
return $errorStack
}
$this currentObj $newObject
# adjust title
$this updateTitle
# adjust parent and treeNode associations
for {set treeNode $newObject} \
{"$treeNode" != ""} \
{set treeNode [$treeNode parent]} {
[$treeNode browsUiObj] treeNode $treeNode
if [isCommand [$treeNode parent]] {
[$treeNode browsUiObj] parent [[$treeNode parent] browsUiObj]
}
}
# adjust the current client context
set levelPath ""
set levelObj ""
for {set contextlvl [$newObject browsUiObj]} \
{"$contextlvl" != ""} \
{set contextlvl [$contextlvl parent]} {
if {! ([$contextlvl isA CustomLevelVersion] ||
([$contextlvl isA FileVersion] &&
[$contextlvl getParent CorporateGroupVersion] == ""))} continue
if {"$levelObj" == ""} {
set levelObj $contextlvl
}
set levelPath "/[$contextlvl identity]$levelPath"
}
if {"$levelPath" == "" &&
[isCommand [$this corporateObj]] &&
(! [[$this corporateObj] isNil])} {
set levelPath "/[[$this corporateObj] identity]"
}
if {"$levelPath" != "[$clientContext currentLevelIdString]"} {
[ClientContext::global] setLevelIds $levelPath
}
# remove undoCommand if no longer valid
if {[isCommand [$this undoCommand]] &&
(! [[$this undoCommand] validAfterLevelChange])} {
[$this undoCommand] delete
}
# read phases file
if [catch {getPhases} msg] {
append errorStack "$msg\n"
}
# adjust the viewspec list
if [catch {[$this viewHdlr] setCurrentContext} msg] {
append errorStack "$msg\n"
}
# adjust the objectspec list
if [catch {[$this objectHdlr] setCurrentContext} msg] {
append errorStack "$msg\n"
}
# retrieve the possible file types
getFileTypes [$this objectHdlr]
# change the view
[$this infoView] setCurrentObj $newObject
# adjust the menu structure to the new situation,
if [catch {[$this menuHdlr] setCurrentContext} msg] {
append errorStack "$msg\n"
}
$this selectionChanged 1
if [isCommand [$this viewSelector]] {
[$this viewHdlr] adjustViewMenu \
"[[$newObject browsUiObj] uiClass]" \
"[[$newObject browsUiObj] browserType]"
}
# adjust the toolBar
[$this infoView] updateToolBarEntries
return $errorStack
}
method CommonBrowser::getSelectedSet {this} {
return [[[$this infoView] area] selectedSet]
}
method CommonBrowser::selectionChanged {this} {
# walk throught the menu structure to determine
# if the menus must be enabled/disabled
[$this menuHdlr] selectionChanged
}
method CommonBrowser::open {this} {
if [$this opened] return
$this opened 1
set id 0
foreach rootId [$this rootIdList] {
set rootObj [[lindex $rootId 0] new [lindex $rootId 1]]
set node [TreeNode new [$this navigationView].node$id $rootObj]
BrowserProcs::initializeInfo $rootObj $node
incr id 1
}
# trigger the selectionChange of the menuHandler, to be sure
# that the menu entries are enabled/disabled correctly
if [isCommand [$this undoButton]] {
[$this undoButton] sensitive 0
}
$this selectionChanged
}
method CommonBrowser::popUp {this} {
$this MainWindow::popUp
$this ready
$this cursor DEFAULT
}
method CommonBrowser::stop {this} {
if {! [$this watchdogBusy]} {
$this WmtTool::stop
}
}
method CommonBrowser::updateTitle {this} {
set currentObj [$this currentObj]
set title [$this title]
set hyphen [string first "-" $title]
if {$hyphen < 0} {
append title " -"
} else {
set title [string range $title 0 $hyphen]
}
set iconTitle [[$currentObj browsUiObj] getInfo Name]
append title " $iconTitle"
$this config \
-title $title \
-iconTitle $iconTitle
}
method CommonBrowser::undoCommandBusy {this {type UndoCommand}} {
set cmd [$this undoCommand]
if {[isCommand $cmd] && [$cmd isA $type] && [$cmd busy]} {
return 1
}
return 0
}
method CommonBrowser::editCut {this} {
if [isCommand [$this undoCommand]] {
[$this undoCommand] delete
}
busy {
set conversionSet(0) [[.main flatView] conversionSet]
[.main flatView] conversionSet "CUT_BROWSUIOBJ contextList"
foreach flatObj [[.main flatView] selectedSet] {
set conversionSet($flatObj) [$flatObj conversionSet]
$flatObj conversionSet "CUT_BROWSUIOBJ contextList"
}
[.main flatView] setClipboardValue
[.main flatView] conversionSet $conversionSet(0)
foreach flatObj [[.main flatView] selectedSet] {
$flatObj conversionSet $conversionSet($flatObj)
}
}
}
method CommonBrowser::editCopy {this} {
if [isCommand [$this undoCommand]] {
[$this undoCommand] delete
}
busy {
[.main flatView] setClipboardValue
}
}
method CommonBrowser::editPaste {this} {
if [isCommand [$this undoCommand]] {
[$this undoCommand] delete
}
require "editpastec.tcl"
global classCount
$this undoCommand [EditPasteCmd new editPasteCmd$classCount]
incr classCount
[$this undoCommand] do
# Cleanup when clipboard is empty
if {[isCommand [$this undoCommand]] &&
[[$this undoCommand] currentObj] == ""} {
[$this undoCommand] delete
}
}
method CommonBrowser::editSelAll {this} {
if [isCommand [$this undoCommand]] {
[$this undoCommand] delete
}
require "editselall.tcl"
global classCount
$this undoCommand [EditSelAllCmd new editSelAllCmd$classCount]
incr classCount
[$this undoCommand] do
}
method CommonBrowser::editDeselAll {this} {
if [isCommand [$this undoCommand]] {
[$this undoCommand] delete
}
require "editdesela.tcl"
global classCount
$this undoCommand [EditDeselAllCmd new editDeselAllCmd$classCount]
incr classCount
[$this undoCommand] do
}
method CommonBrowser::editSelInv {this} {
if [isCommand [$this undoCommand]] {
[$this undoCommand] delete
}
require "editselinv.tcl"
global classCount
$this undoCommand [EditSelInvCmd new editSelInvCmd$classCount]
incr classCount
[$this undoCommand] do
}
method CommonBrowser::editUndo {this} {
if [isCommand [$this undoCommand]] {
[$this undoCommand] toggleUndo
}
}
# Do not delete this line -- regeneration end marker
method CommonBrowser::addPropContainer {this newPropContainer} {
[$this propContainerSet] append $newPropContainer
}
method CommonBrowser::removePropContainer {this oldPropContainer} {
[$this propContainerSet] removeValue $oldPropContainer
}