home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World 1998 October
/
PCWorld_1998-10_cd.bin
/
software
/
prehled
/
komix
/
DATA.Z
/
infoview.tcl
< prev
next >
Wrap
Text File
|
1997-09-19
|
15KB
|
536 lines
#---------------------------------------------------------------------------
#
# (c) Cayenne Software Inc. 1997
#
# File: @(#)infoview.tcl /main/titanic/9
# Author: <generated>
# Description:
#---------------------------------------------------------------------------
# SccsId = @(#)infoview.tcl /main/titanic/9 19 Sep 1997 Copyright 1997 Cayenne Software Inc.
# Start user added include file section
require "infoheader.tcl"
require "infoobject.tcl"
require "fastviewha.tcl"
# End user added include file section
Class InfoView : {DlgRow} {
method destructor
constructor
method clear
method display
method print
method saveContents
method setCurrentObj
method sort
method updateToolBarEntries
method addNewObject
method removeNewObject
method addOldObject
method removeOldObject
method getVisible
method setVisible
method removeVisible
attribute area
attribute currentObj
attribute currentViewName
attribute currentViewObj
attribute currentViewProperties
attribute currentViewToolBarEntries
attribute count
attribute fastViewHandler
attribute removedObj
attribute newObjectSet
attribute oldObjectSet
attribute currentSpec
attribute visible
}
method InfoView::destructor {this} {
# Start destructor user section
[$this fastViewHandler] delete
# End destructor user section
}
constructor InfoView {class this name} {
set this [DlgRow::constructor $class $this $name]
$this visible [Dictionary new]
$this oldObjectSet [List new]
$this newObjectSet [List new]
# Initialize attributes
$this count 0
$this currentViewName "Default"
$this fastViewHandler [FastViewHandler new $this.fastViewHandler]
return $this
}
method InfoView::clear {this} {
[$this newObjectSet] foreach object {
$object delete
}
[$this newObjectSet] contents ""
foreach header [[$this area] headerSet] {
$header delete
}
}
method InfoView::display {this viewName} {
set currentObj [$this currentObj]
if {! [isCommand $currentObj]} {
$this clear
return
}
[$this fastViewHandler] checkView $this
# Determine current view specification
set removedObj [$this removedObj]
if {[isCommand $removedObj] && $removedObj == $currentObj} {
set skipError 1
} else {
set skipError 0
}
set obj [$currentObj browsUiObj]
if [catch {set browserType [$obj browserType]} errorMsg] {
if $skipError {
resetErrorVars
} else {
wmtkerror $errorMsg
}
$this clear
return
}
set objType [$obj uiClass]
if {"$viewName" == ""} {
set viewName "[$this currentViewName]"
}
# GroundWorks does not have a Default view on Corporate level
if {"$viewName" == "Default" &&
"$objType" == "Corporate"} {
set inDefaultCorporateView 1
if {(! [isCommand [[.main moduleHdlr] getModuleSpec objectteam]]) &&
[isCommand [[.main moduleHdlr] getModuleSpec groundworks]]} {
set viewName "GroundWorks"
}
} else {
set inDefaultCorporateView 0
}
# check first fastViewHandler
set currentSpec [[$this fastViewHandler] getViewSpec \
"$objType" "$browserType" "$viewName" \
]
if {$currentSpec == ""} {
$this currentSpec [[$wmttoolObj viewHdlr] getViewSpec \
"$objType" "$browserType" "$viewName" \
]
} else {
$this currentSpec $currentSpec
}
# Clear view and return if view-spec could not be found
if {! [isCommand [$this currentSpec]]} {
if {(! $inDefaultCorporateView) && "$viewName" != "Default"} {
$this display Default
return
}
$this currentViewName $viewName
$this currentViewObj $obj
$this currentViewProperties ""
$this clear
wmtkerror \
"Could not find default view specification '$objType $browserType'"
return
}
# Determine if headers should be removed
if {"[$this currentViewProperties]" == "[[$this currentSpec] properties]"} {
set removeHeaders 0
} else {
set removeHeaders 1
}
$this currentViewProperties [[$this currentSpec] properties]
# Need to update the toolBarEntries when changing view only
if {[isCommand [$wmttoolObj toolBar]] &&
"$obj" == "[$this currentViewObj]" &&
"$viewName" != "[$this currentViewName]"} {
$this updateToolBarEntries 1
}
$this currentViewName $viewName
$this currentViewObj $obj
if [isCommand [$wmttoolObj wmtArea]] {
[$wmttoolObj wmtArea] updateViewInfo
}
busy {
# Retrieve the children repository objects
set errorStack \
[$obj initializeChildSet [[$this currentSpec] associations]]
if {"$errorStack" != ""} {
if [info exists errorInfo] {
set errorInfoCopy $errorInfo
} else {
set errorInfoCopy ""
}
if [info exists errorCode] {
set errorCodeCopy $errorCode
} else {
set errorCodeCopy ""
}
}
# Initialize
set childSet ""
foreach association [[$this currentSpec] associations] {
append childSet " [$obj getChildSet $association]"
}
foreach objectType [[$this visible] names] {
$this removeVisible $objectType
}
set objectTypes [[$this currentSpec] objectTypes]
if [lempty $objectTypes] {
set checkObjectTypes 0
} else {
set checkObjectTypes 1
foreach objectType $objectTypes {
$this setVisible $objectType 1
}
}
set headerCount 0
foreach headerSpec [$this currentViewProperties] {
set j 0
foreach element $headerSpec {
set headerMatrix($headerCount,$j) $element
incr j 1
}
incr headerCount 1
}
# Create header row
if $removeHeaders {
$this clear
for {set id 0} {$id < $headerCount} {incr id 1} {
set header [$this area].header$id
InfoHeader new $header \
-label "$headerMatrix($id,0)" \
-width "$headerMatrix($id,1)" \
-type "$headerMatrix($id,2)" \
-sortPolicy "[lindex $headerMatrix($id,3) 0]" \
-sortIndex [lindex $headerMatrix($id,3) 1]
}
}
# Create rows
set index 0
set count [$this count]
[$this oldObjectSet] contents [[$this area] objectSet]
[$this newObjectSet] contents ""
foreach child $childSet {
set object [$child infoObject]
$child parent $obj
BrowserProcs::initializeInfo $child $child
# Create row, skip if child's type is invisible
set uiType "[$child browserType]"
if {$checkObjectTypes &&
"[$this getVisible $uiType]" == ""} continue
if {"$object" == ""} {
set object [$this area].object$count
incr count
InfoObject new $object $child
} else {
$this removeOldObject $object
}
$this addNewObject $object
# Determine label and details
set label ""
set details ""
for {set i 0} {$i < $headerCount} {incr i 1} {
set column "$headerMatrix($i,0)"
set value "[$child getInfo $column]"
if {"$column" == "Name"} {
set value "[$child uiPrefix]$value"
}
if {$i == 0} {
set label "$value"
} else {
lappend details "$value"
}
}
# Update row
set childType "[$child uiClass]"
set typeSpec \
[getObjectSpec [$wmttoolObj objectHdlr] "$childType" "$uiType"]
if {"$typeSpec" != ""} {
set smallIcon "[$typeSpec smallIcon]"
set largeIcon "[$typeSpec largeIcon]"
set activated "[$typeSpec defaultAction]"
} else {
set smallIcon ""
set largeIcon ""
set activated ""
}
$object config \
-index $index \
-smallIcon "$smallIcon" \
-largeIcon "$largeIcon" \
-label "$label" \
-details "$details" \
-activated "$activated"
incr index 1
}
$this count $count
[$this oldObjectSet] foreach object {
$object delete
}
if [isCommand [$wmttoolObj filterHdlr]] {
[$wmttoolObj filterHdlr] filter
}
# Sort the view
$this sort
}
if {"$errorStack" != ""} {
if $skipError {
resetErrorVars
} else {
global errorInfo errorCode
set errorInfo $errorInfoCopy
set errorCode $errorCodeCopy
wmtkerror $errorStack
}
}
}
method InfoView::print {this} {
set printer [m4_var get M4_a_printer]
set printfile [args_file {}]
$this saveContents $printfile
$wmttoolObj startCommand extern \
"$printer $printfile" [list BasicFS::removeFile $printfile] \
"Sending output to $printer..." \
{0 0} 0
}
method InfoView::saveContents {this printFile} {
set fid [open $printFile w]
set limit [m4_var get M4_a_printer_llen]
# Print level information
if [isCommand [$wmttoolObj wmtArea]] {
set arrayList ""
set projectInfo [[$wmttoolObj wmtArea] projectInfo]
lappend arrayList "\
\"[$projectInfo labelText]\" \"[$projectInfo valueText]\""
set configInfo [[$wmttoolObj wmtArea] configInfo]
lappend arrayList "\
\"[$configInfo labelText]\" \"[$configInfo valueText]\""
set phaseInfo [[$wmttoolObj wmtArea] phaseInfo]
lappend arrayList "\
\"[$phaseInfo labelText]\" \"[$phaseInfo valueText]\""
set systemInfo [[$wmttoolObj wmtArea] systemInfo]
lappend arrayList "\
\"[$systemInfo labelText]\" \"[$systemInfo valueText]\""
set viewInfo [[$wmttoolObj wmtArea] viewInfo]
lappend arrayList "\
\"[$viewInfo labelText]\" \"[$viewInfo valueText]\""
set filterInfo [[$wmttoolObj wmtArea] filterInfo]
lappend arrayList "\
\"[$filterInfo labelText]\" \"[$filterInfo valueText]\""
set lengths [maxLengthList $arrayList]
set formatString "%-*.*s %-*.*s"
foreach array $arrayList {
set line [format "$formatString" \
[lindex $lengths 0] [lindex $lengths 0] [lindex $array 0] \
[lindex $lengths 1] [lindex $lengths 1] [lindex $array 1]]
foreach part [lineBreak $line $limit " "] {puts $fid $part}
}
puts $fid "\n"
}
# Print view information
set i 0
set line ""
foreach header [[$this area] headerSet] {
set len($i) [expr [$header width] + 1]
append line [format "%-*.*s" $len($i) $len($i) [$header label]]
incr i 1
}
if {$i == 0} {
close $fid
return
}
foreach part [lineBreak $line $limit " "] {puts $fid $part}
set line ""
for {set count 0} {$count < $i} {incr count 1} {
for {set column 0} {$column < $len($count)} {incr column 1} {
append line "="
}
}
foreach part [lineBreak $line $limit " "] {puts $fid $part}
foreach object [[$this area] objectSet] {
set line ""
if [$object filteredOutState] continue
append line [format "%-*.*s" $len(0) $len(0) [$object label]]
set i 1
foreach detail [$object details] {
append line [format "%-*.*s" $len($i) $len($i) $detail]
incr i 1
}
foreach part [lineBreak $line $limit " "] {puts $fid $part}
}
close $fid
}
method InfoView::setCurrentObj {this newObject} {
$this currentObj $newObject
$this display [$this currentViewName]
}
method InfoView::sort {this} {
if [[$this newObjectSet] empty] {
return
}
foreach header [[$this area] headerSet] {
if {"[$header sortPolicy]" == "none"} continue
set index [$header sortIndex]
if {("$index" == "") || ($index < 1)} continue
set sortSpec($index) \
"-column {$header [$header type] [$header sortPolicy]}"
}
set sortSpecList ""
if [catch {set indices [lsort -integer [array names sortSpec]]}] {
global errorInfo
set errorInfo ""
global errorCode
set errorCode ""
} else {
foreach index $indices {
append sortSpecList " $sortSpec($index)"
}
}
set sortProc [[$this currentSpec] sortScript]
if {"$sortProc" != ""} {
set sortSpecList "$sortSpecList -command $sortProc"
}
if [lempty $sortSpecList] {
set sortSpecList "-command InfoObject::sort"
}
eval [$this area] sort $sortSpecList
}
method InfoView::updateToolBarEntries {this {removeEntries 0}} {
# ToolBar entries are added:
# - in the customizehandler when a menu entry has inToolBar set to 1
# - here, according to toolBarEntries of viewSpec
if {! [isCommand [$wmttoolObj toolBar]]} {
return
}
# Determine current toolBar entries
# - remove toolBar entries specified in previous view
# - add toolBar entries specified in current view
set oldEntrySet [[$wmttoolObj toolBar] entrySet]
if $removeEntries {
foreach entry [$this currentViewToolBarEntries] {
set removeEntry($entry) 1
}
foreach entry $oldEntrySet {
if [info exists removeEntry($entry)] continue
lappend toolBarEntries $entry
}
} else {
set toolBarEntries $oldEntrySet
}
if [isCommand [$this currentSpec]] {
foreach entry [[$this currentSpec] toolBarEntries] {
if {"$entry" != "SEPARATOR"} {
set entry "[$wmttoolObj menuBar]$entry"
set viewEntry($entry) 1
}
lappend toolBarEntries $entry
}
}
# Check toolBar entries
# - skip entries of non-existing buttons
# - skip double entries
# - skip dummy separators
set separator 0
set entrySet ""
set viewToolBarEntries ""
foreach entry $toolBarEntries {
if {"$entry" == "SEPARATOR" && $separator == 0} {
lappend entrySet "$entry"
set separator 1
} else {
if {! [isCommand $entry]} continue
if [info exists toolBarEntry($entry)] continue
lappend entrySet "$entry"
if [info exists viewEntry($entry)] {
lappend viewToolBarEntries $entry
}
set toolBarEntry($entry) 1
set separator 0
}
}
if {[llength $toolBarEntries] > 0 && "$entry" == "SEPARATOR"} {
set entrySet [lreplace $entrySet [expr [llength $entrySet] - 1] end]
}
$this currentViewToolBarEntries $viewToolBarEntries
# Set toolBar entries if necessary
if {$entrySet != $oldEntrySet} {
[$wmttoolObj toolBar] entrySet $entrySet
}
}
# Do not delete this line -- regeneration end marker
method InfoView::addNewObject {this newNewObject} {
[$this newObjectSet] append $newNewObject
}
method InfoView::removeNewObject {this oldNewObject} {
[$this newObjectSet] removeValue $oldNewObject
}
method InfoView::addOldObject {this newOldObject} {
[$this oldObjectSet] append $newOldObject
}
method InfoView::removeOldObject {this oldOldObject} {
[$this oldObjectSet] removeValue $oldOldObject
}
method InfoView::getVisible {this objectType} {
return [[$this visible] set $objectType]
}
method InfoView::setVisible {this objectType newVisible} {
[$this visible] set $objectType $newVisible
}
method InfoView::removeVisible {this objectType} {
[$this visible] unset $objectType
}