home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World 1998 October
/
PCWorld_1998-10_cd.bin
/
software
/
prehled
/
komix
/
DATA.Z
/
commonbrow.tcl
< prev
next >
Wrap
Text File
|
1997-11-17
|
20KB
|
736 lines
#---------------------------------------------------------------------------
#
# (c) Cayenne Software Inc. 1997
#
# File: @(#)commonbrow.tcl /main/titanic/41
# Author: <generated>
# Description:
#---------------------------------------------------------------------------
# SccsId = @(#)commonbrow.tcl /main/titanic/41 17 Nov 1997 Copyright 1997 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 "histwmttoo.tcl"
Class CommonBrowser : {HistWmtTool MainWindow} {
method destructor
constructor
method createInterface
method currentObj
method mkHistEntry
method historyActivated
method findTreeNode
method addContextArea
method updateToolBar
method updateWmtArea
method createPropContainers
method releasePropContainers
method setCurrentObj
method getSelectedSet
method flatView
method treeView
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 customLevelVersion
attribute cutObjects
attribute cutFileVersions
attribute corporateObj
attribute rootIdList
attribute viewSelector
attribute historyCount
attribute opened
# Set of selected objects in this browser.
#
attribute selectedSet
# The owner of the selected objects in the browser
# (the tree or the navigation view).
#
attribute selectionOwner
attribute moduleHdlr
attribute filterHdlr
attribute objectHdlr
attribute viewHdlr
attribute menuHdlr
attribute wmtArea
attribute navigationView
attribute infoView
attribute m4VarDes
attribute options
attribute propContainerSet
attribute undoCommand
}
method CommonBrowser::destructor {this} {
# Start destructor user section
if [$this opened] {
$this saveHist desk
$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
[$this moduleHdlr] delete
[$this m4VarDes] delete
[$this options] delete
}
# End destructor user section
$this HistWmtTool::destructor
}
constructor CommonBrowser {class this name toolId} {
set this [MainWindow::constructor $class $this $name]
set this [HistWmtTool::constructor $class $this $name]
$this config -historyCount 0 -opened 0
global classCount
set classCount 0
global makeSelectionUpToDate
set makeSelectionUpToDate 1
$this m4VarDes [M4VarDescription new $this.m4VarDes]
$this options [BrowserOptions new $this.options]
[$this options] setContexts editor {""}
[$this options] setContexts previewer {""}
[$this options] setContexts viewer {""}
$this moduleHdlr [ModuleHandler new \
-moduleSpecSetChanged {
set d_modules [%this deselectedModuleSpecSet]
foreach file [%this getFiles tcl d_desk.tcl $d_modules] {
source $file
}
set s_modules [%this selectedModuleSpecSet]
foreach file [%this getFiles tcl s_desk.tcl $s_modules] {
source $file
}
# clear dictionary, used in the proc module_promoter in proc.tcl
global modulePromoterSet
$modulePromoterSet contents ""
} \
]
global globalModuleHandler
set globalModuleHandler [$this moduleHdlr]
MenuBar new $this.MB
$this menuHdlr [CustBrMenuHandler new $toolId [$this moduleHdlr]]
$this createInterface
eval [[$this moduleHdlr] moduleSpecSetChanged]
$this viewHdlr [CustViewHandler new $toolId [$this moduleHdlr]]
$this objectHdlr [CustObjHandler new [$this moduleHdlr]]
$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 abbrev}
$this loadHist desk
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::currentObj {this {newObject ""}} {
if {"$newObject" != ""} {
$this _currentObj $newObject
return
}
set currentObj [$this _currentObj]
if {$makeSelectionUpToDate && "$currentObj" != ""} {
[$currentObj browsUiObj] makeUpToDate
}
return $currentObj
}
method CommonBrowser::mkHistEntry {this levelPath mnem {treeNode ""}} {
set latest [$this historyCount]
incr latest
set abbrev [HistWmtTool::abbrevLevelPath $levelPath]
set button [$this menuBar].file.menu.his$latest
HistMenuButton new $button \
-label "$mnem $abbrev" -abbrev $abbrev \
-treeNode $treeNode -levelPath $levelPath \
-activated "$this historyActivated %this" \
-mnemonic $mnem -hintText "Opens $levelPath."
$this historyCount $latest
return $button
}
method CommonBrowser::historyActivated {this entry} {
if {![isCommand [$entry treeNode]]} {
$entry treeNode [$this findTreeNode [$entry levelPath]]
}
if [isCommand [$entry treeNode]] {
[$entry treeNode] open
} else {
InfoDialog new .main.info -message \
"[$entry levelPath]:\n does not exist"
.main.info popUp
$this removeHistory $entry
$this renumberHist
$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::addContextArea {this} {
$this wmtArea [BrowseWmtArea new $this.DC.WA]
}
method CommonBrowser::updateToolBar {this} {
if [catch {[$this menuHdlr] setCurrentContext} errorMsg] {
if [info exists errorInfo] {
set errorInfoCopy $errorInfo
} else {
set errorInfoCopy ""
}
if [info exists errorCode] {
set errorCodeCopy $errorCode
} else {
set errorCodeCopy ""
}
resetErrorVars
} else {
set errorMsg ""
}
[$this infoView] updateToolBarEntries
if {"$errorMsg" != ""} {
global errorInfo errorCode
set errorInfo $errorInfoCopy
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] {
return
}
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
set customLevelVersion [$newObject browsUiObj]
if {! [$customLevelVersion isA CustomLevelVersion]} {
set customLevelVersion [$newObject getParent CustomLevelVersion]
}
$this customLevelVersion $customLevelVersion
# 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]"
}
set clientContext [ClientContext::global]
if {"$levelPath" != "[$clientContext currentLevelIdString]"} {
$clientContext setLevelIds $levelPath
}
# remove undoCommand if no longer valid
if {[isCommand [$this undoCommand]] &&
(! [[$this undoCommand] validAfterLevelChange])} {
[$this undoCommand] delete
}
# adjust the list of selected modules
[$this moduleHdlr] setCurrentContext
# read phases file
if [catch {getPhases} msg] {
append errorStack "$msg\n"
resetErrorVars
}
# adjust the viewspec list
if [catch {[$this viewHdlr] setCurrentContext} msg] {
append errorStack "$msg\n"
resetErrorVars
}
# adjust the objectspec list
if [catch {[$this objectHdlr] setCurrentContext} msg] {
append errorStack "$msg\n"
resetErrorVars
}
# 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"
resetErrorVars
}
$this selectionChanged 1
if [isCommand [$this viewSelector]] {
[$this viewHdlr] adjustViewMenu \
"[[$newObject browsUiObj] uiClass]" \
"[[$newObject browsUiObj] browserType]"
}
# adjust the toolBar
[$this infoView] updateToolBarEntries
checkModuleWarnings
return $errorStack
}
method CommonBrowser::getSelectedSet {this} {
return [[[$this infoView] area] selectedSet]
}
method CommonBrowser::flatView {this} {
return [[$this infoView] area]
}
method CommonBrowser::treeView {this} {
return [$this navigationView]
}
method CommonBrowser::selectionChanged {this} {
# determine selection owner
set treeSelection [[$this treeView] selected]
if [llength $treeSelection] {
$this selectionOwner [$this treeView]
} else {
$this selectionOwner [$this flatView]
}
$this selectedSet [concat $treeSelection \
[[.main flatView] selectedSet]]
# walk throught the menu structure to determine
# if the menus must be enabled/disabled
global makeSelectionUpToDate
set makeSelectionUpToDate 0
[$this menuHdlr] selectionChanged
set makeSelectionUpToDate 1
}
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} {
[[$this infoView] fastViewHandler] checkView [$this infoView]
[[$this infoView] fastViewHandler] saveObjects
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 {
# reset previous cutState
foreach object [$this cutObjects] {
if [isCommand $object] {
$object cutState 0
}
}
# save old conversion sets and changed BROWSUIOBJ to CUT_BROWSUIOBJ
# to force cut operation
set conversionSet(0) [[.main flatView] conversionSet]
[.main flatView] conversionSet "CUT_BROWSUIOBJ contextList"
foreach object [$this selectedSet] {
set conversionSet($object) [$object conversionSet]
$object conversionSet "CUT_BROWSUIOBJ contextList"
}
# save cut objects so cut state can be reset later
$this cutObjects [$this selectedSet]
set cutFileVersions ""
foreach object [$this cutObjects] {
if [[$object browsUiObj] isA FileVersion] {
lappend cutFileVersions [$object browsUiObj]
}
}
$this cutFileVersions $cutFileVersions
[$this selectionOwner] setClipboardValue
[.main flatView] conversionSet $conversionSet(0)
foreach object [$this selectedSet] {
# set current cutState
$object conversionSet $conversionSet($object)
$object cutState 1
}
}
}
method CommonBrowser::editCopy {this} {
if [isCommand [$this undoCommand]] {
[$this undoCommand] delete
}
busy {
[$this selectionOwner] 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]]} {
if { [[$this undoCommand] currentObj] == ""} {
[$this undoCommand] delete
} else {
[[$this undoCommand] currentObj] cutState 0
}
}
}
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
}