home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World 1997 November
/
PCWorld_1997-11_cd.bin
/
software
/
programy
/
komix
/
DATA.Z
/
groupvstrd.tcl
< prev
next >
Wrap
Text File
|
1996-11-18
|
19KB
|
725 lines
#---------------------------------------------------------------------------
#
# (c) Westmount Technology 1994
#
# File: @(#)groupvstrd.tcl /main/hindenburg/9
# Author: <generated>
# Description:
#---------------------------------------------------------------------------
# SccsId = @(#)groupvstrd.tcl /main/hindenburg/9 18 Nov 1996 Copyright 1994 Westmount Technology
# Start user added include file section
require "groupvstrs.tcl"
# End user added include file section
Class GroupVStrDlg : {TemplateDialog} {
constructor
method destructor
method fileSelectorDialog
method filterDialog
method itemSelectorDialog
method listDialog
method modeChanged
method newObject
method popUp
method removeObjects
method showObjects
method showObjectsOk
attribute editable
attribute currentMode
attribute currentRepObjList
attribute groupV
}
constructor GroupVStrDlg {class this name groupV} {
set this [TemplateDialog::constructor $class $this $name]
$this groupV $groupV
# Start constructor user section
$this delCancelButton
$this okPressed {%this delete}
interface DlgColumn $this.top {
NamedGroup mode {
label mode
mnemonic m
horStretchFactor 0
verStretchFactor 0
horShrinkFactor 0
verShrinkFactor 0
OptionMenu optmenu {}
}
DlgRow menu {
horStretchFactor 0
verStretchFactor 0
horShrinkFactor 0
verShrinkFactor 0
PushButton new {
label New...
}
PushButton show {
label Show...
}
PushButton delete {
label Delete...
}
}
Label contentsLab {
text "Contents:"
alignment CENTER
}
BrowsView view {
horStretchFactor 10
verStretchFactor 10
horShrinkFactor 10
verShrinkFactor 10
rowCount 10
columnCount 52
mode DETAIL
BrowsHeader header0 {
label Name
width 20
}
BrowsHeader header1 {
label Type
width 18
}
BrowsHeader header2 {
label Status
width 14
}
}
}
$this.top.view font "[m4_var get M4_font -context desk]"
$this.top.mode.optmenu selectionChanged [list $this modeChanged 0]
$this.top.menu.new activated [list $this newObject]
$this.top.menu.show activated [list $this showObjects]
$this.top.menu.delete activated [list $this removeObjects]
# End constructor user section
return $this
}
method GroupVStrDlg::destructor {this} {
# Start destructor user section
if [$this editable] {
[$this groupV] quit
}
# End destructor user section
}
method GroupVStrDlg::fileSelectorDialog {this msg} {
set fileTypes {cad ccd cdm dfd etd mgd std ucd}
set itemTypes {cl de et pe st}
foreach fileSelector [[$this groupV] fileSelectors] {
set id [lsearch -exact $itemTypes [$fileSelector itemType]]
if {$id == -1} continue
set itemTypes [lreplace $itemTypes $id $id]
}
if [lempty $itemTypes] {
wmtkinfo $msg
return
}
global classCount
set box [getParent $this].groupVStrFileSelectorDialog$classCount
incr classCount
ClassMaker::extend TemplateDialog GroupVStrFileSelectorDlg \
{groupV dialog}
GroupVStrFileSelectorDlg new $box \
-modal [$this editable] \
-title "New File Selector" \
-groupV [$this groupV] \
-dialog $this \
-helpPressed {.main helpOnName groupVStrFileSelectorDialog} \
-cancelPressed {
%this delete
} \
-okPressed {
set itemType [lindex [%this.top.itemTypes.list selectedSet] 0]
set decompFlags ""
foreach decompFlag [%this.top.decompFlags.list selectedSet] {
lappend decompFlags "decomp$decompFlag"
}
set fileTypes [%this.top.fileTypes.list selectedSet]
if {"$itemType" != "" &&
(! [lempty $decompFlags]) && (! [lempty $fileTypes])} {
[%this groupV] addFileSelector \
$itemType $decompFlags $fileTypes
[%this dialog] modeChanged
}
%this delete
}
interface DlgRow $box.top {
NamedGroup itemTypes {
label "item type"
mnemonic i
TextList list {
rowCount 8
selectionPolicy BROWSE
}
}
NamedGroup decompFlags {
label "decomp flags"
mnemonic d
TextList list {
selectionPolicy EXTENDED
entrySet {Files Components Parents Leafs}
}
}
NamedGroup fileTypes {
label "file types"
mnemonic f
TextList list {
selectionPolicy EXTENDED
}
}
}
$box.top.itemTypes.list entrySet $itemTypes
$box.top.fileTypes.list entrySet $fileTypes
$box popUp
}
method GroupVStrDlg::filterDialog {this otype ftypeList} {
global classCount
set box [getParent $this].groupVStrFilterDialog$classCount
incr classCount
ClassMaker::extend TemplateDialog GroupVStrFilterDlg \
{groupV otype ftypeList dialog}
set firstChar [string toupper [string range $otype 0 0]]
set title "New $firstChar[string range $otype 1 end] Filter"
GroupVStrFilterDlg new $box \
-modal [$this editable] \
-title "$title" \
-groupV [$this groupV] \
-otype $otype \
-ftypeList $ftypeList \
-dialog $this \
-helpPressed {.main helpOnName groupVStrFilterDialog} \
-cancelPressed {
%this delete
} \
-okPressed {
set groupV [%this groupV]
set otype [%this otype]
set name ""
set type ""
set property ""
set pattern ""
set id 0
set count 0
foreach ftype [%this ftypeList] {
set row %this.top.row$id
incr id 1
if {! [$row.labCol.name state]} continue
incr count 1
set valCol $row.valCol
case "$ftype" in {
{name} {
regsub -all ":" "[$valCol.pattern text]" "\[:|/\]" name
}
{type} {
set type "[$valCol.pattern text]"
}
{property} {
set property "[$valCol.property text]"
set pattern "[$valCol.pattern text]"
}
}
}
if $count {
$groupV addFilter $otype "$name" "$type" "$property" "$pattern"
}
[%this dialog] modeChanged
%this delete
}
set top [DlgColumn new $box.top]
set id 0
foreach ftype $ftypeList {
set row [DlgRow new $top.row$id]
incr id 1
set labCol [DlgColumn new $row.labCol]
ClassMaker::extend CheckButton FtypeCheckButton {box ftypeList}
FtypeCheckButton new $labCol.name \
-state 0 \
-box $box \
-ftypeList $ftypeList
set valCol [DlgColumn new $row.valCol]
case "$ftype" in {
{property} {
$labCol.name label "${ftype}"
Label new $valCol.propertyLab -text "name:"
set entry [SingleLineText new $valCol.property \
-editable yes \
-text "" \
]
Label new $valCol.patternLab -text "value:"
set value "*"
set entry [SingleLineText new $valCol.pattern \
-editable yes \
-text "$value" \
]
}
{default} {
$labCol.name label "${ftype}:"
set value "*"
set entry [SingleLineText new $valCol.pattern \
-editable yes \
-text "$value" \
]
}
}
}
$box popUp
}
method GroupVStrDlg::itemSelectorDialog {this msg} {
set itemTypes {cl de et pe st}
set len [llength $itemTypes]
set fileTypes ""
foreach fileType {cad ccd cdm dfd etd mgd std ucd} {
if {[llength [[$this groupV] findItemSelectors $fileType]] != $len} {
lappend fileTypes $fileType
}
}
if [lempty $fileTypes] {
wmtkinfo $msg
return
}
global classCount
set box [getParent $this].groupVStrItemSelectorDialog$classCount
incr classCount
ClassMaker::extend TemplateDialog GroupVStrItemSelectorDlg \
{groupV dialog itemTypes}
GroupVStrItemSelectorDlg new $box \
-modal [$this editable] \
-title "New Item Selector" \
-groupV [$this groupV] \
-dialog $this \
-itemTypes $itemTypes \
-helpPressed {.main helpOnName groupVStrItemSelectorDialog} \
-cancelPressed {
%this delete
} \
-okPressed {
set fileType [lindex [%this.top.fileTypes.list selectedSet] 0]
set itemTypes ""
foreach itemType [%this itemTypes] {
set row %this.top.itemTypes.row
if {! [$row.type.$itemType state]} continue
set qualified [$row.qualified.$itemType selected]
if {"$qualified" != "yes"} {
set qualified "dontCare"
}
lappend itemTypes [list $itemType $qualified]
}
if {"$fileType" != "" && (! [lempty $itemTypes])} {
foreach itemType $itemTypes {
[%this groupV] addItemSelector \
$fileType [lindex $itemType 0] [lindex $itemType 1]
}
[%this dialog] modeChanged
}
%this delete
}
interface DlgRow $box.top {
NamedGroup fileTypes {
label "file type"
mnemonic f
TextList list {
selectionPolicy BROWSE
}
}
NamedGroup itemTypes {
label "item types"
mnemonic i
DlgRow row {
DlgColumn type {
spaceType LREVEN
Label label {
text "type:"
}
}
DlgColumn qualified {
spaceType LREVEN
Label label {
text "qualified:"
}
}
}
}
}
foreach itemType [$box itemTypes] {
set row $box.top.itemTypes.row
CheckButton new $row.type.$itemType \
-sensitive 0 \
-state 0 \
-label $itemType
OptionMenu new $row.qualified.$itemType \
-sensitive 0 \
-entrySet {"don't care" yes}
}
$box.top.fileTypes.list config \
-entrySet $fileTypes \
-selectionChanged {
set fileType [lindex [%this selectedSet] 0]
set box [getParent [getParent [getParent %this]]]
set groupV [$box groupV]
foreach itemType [$box itemTypes] {
set row $box.top.itemTypes.row
if [[$groupV findItemSelector $fileType $itemType] isNil] {
set sensitive 1
} else {
set sensitive 0
$row.type.$itemType state 0
$row.qualified.$itemType selected "don't care"
}
$row.type.$itemType sensitive $sensitive
$row.qualified.$itemType sensitive $sensitive
}
}
$box popUp
}
method GroupVStrDlg::listDialog {this objList title msg okCmd scCmd} {
if [lempty $objList] {
wmtkinfo $msg
return
}
global classCount
set box [getParent $this].groupVStrSubDialog$classCount
incr classCount
GroupVStrSubDlg new $box $this \
-modal [$this editable] \
-objectList $objList \
-title $title \
-okCmd $okCmd \
-scCmd $scCmd
$box popUp
}
method GroupVStrDlg::modeChanged {this {forceFlag 1}} {
set currentMode [$this.top.mode.optmenu selected]
if {! $forceFlag} {
set mode [$this currentMode]
if {"$mode" == "$currentMode"} {
return
}
}
$this currentMode $currentMode
# Enable / disable buttons
case "$currentMode" in {
{overview} {
$this.top.menu.new sensitive 0
$this.top.menu.show sensitive 0
$this.top.menu.delete sensitive 0
}
{"explicit group version"
"explicit file"
"file selector"
"item selector"} {
$this.top.menu.show sensitive 0
$this.top.menu.new sensitive [$this editable]
$this.top.menu.delete sensitive [$this editable]
}
{default} {
$this.top.menu.show sensitive 1
$this.top.menu.new sensitive [$this editable]
$this.top.menu.delete sensitive [$this editable]
}
}
# Check if the view should be updated
if {! $forceFlag} {
set checkList {"file selector" "item selector"}
if {[lsearch -exact $checkList "$mode"] != -1 &&
[lsearch -exact $checkList "$currentMode"] != -1} {
return
}
}
# Fill the view
set groupV [$this groupV]
case "$currentMode" in {
{overview} {
set sysV [$groupV getParent SystemVersion]
set confV [$sysV getParent ConfigVersion]
$this showObjectsOk [$groupV selectorEngine $sysV $confV] 1
}
{"explicit group version"} {
set sysV [$groupV getParent SystemVersion]
$this showObjectsOk [$groupV explicitSubgroupVersions $sysV] 1
}
{"group version filter"} {
$this showObjectsOk [$groupV filterSubgroupVersions ""] 1
}
{"explicit file"} {
set sysV [$groupV getParent SystemVersion]
$this showObjectsOk [$groupV explicitFileVersions $sysV] 1
}
{"file filter"} {
$this showObjectsOk [$groupV filterFileVersions ""] 1
}
{"item filter"} {
set sysV [$groupV getParent SystemVersion]
$this showObjectsOk [$groupV filterItems ""] 1
}
{"file selector" "item selector"} {
set sysV [$groupV getParent SystemVersion]
set confV [$sysV getParent ConfigVersion]
$this showObjectsOk [$groupV localSelectorEngine $sysV $confV] 1
}
}
}
method GroupVStrDlg::newObject {this} {
case "[$this currentMode]" in {
{"explicit group version"} {
set groupV [$this groupV]
set sysV [$groupV getParent SystemVersion]
set subgroupVList [$sysV groupVersions]
set id [lsearch -exact $subgroupVList "$groupV"]
set subgroupVList [lreplace "$subgroupVList" $id $id]
foreach subgroupV [$groupV explicitSubgroupVersions $sysV] {
set id [lsearch -exact $subgroupVList "$subgroupV"]
if {$id == -1} continue
set subgroupVList [lreplace "$subgroupVList" $id $id]
}
$this listDialog \
"$subgroupVList" \
"New Explicit Subgroup" \
"All subgroup versions within the current system have already \
been added as explicit subgroup version" \
addExplicitSubgroup \
""
}
{"group version filter"} {
$this filterDialog subgroup {name property}
}
{"explicit file"} {
set groupV [$this groupV]
set sysV [$groupV getParent SystemVersion]
set fileList ""
foreach fileV [$sysV localFileVersions] {
lappend fileList [$fileV file]
}
foreach file [$groupV explicitFiles] {
set id [lsearch -exact $fileList "$file"]
if {$id == -1} continue
set fileList [lreplace "$fileList" $id $id]
}
$this listDialog \
"$fileList" \
"New Explicit File" \
"All files within the current system have already \
been added as explicit file" \
addExplicitFile \
""
}
{"file filter"} {
$this filterDialog file {name type property}
}
{"file selector"} {
$this fileSelectorDialog \
"A FileSelector already exists for each item-type"
}
{"item filter"} {
$this filterDialog item {name type property}
}
{"item selector"} {
$this itemSelectorDialog \
"An ItemSelector already exists for each \
file- and item-type combination"
}
}
}
method GroupVStrDlg::popUp {this} {
if {[$this editable] && [catch {[$this groupV] edit} errorMsg]} {
if [info exists errorInfo] {
set errorTrace $errorInfo
set errorCodeCopy $errorCode
} else {
set errorTrace ""
set errorCodeCopy ""
}
$this editable 0
} else {
set errorMsg ""
}
# Set the mode entrySet
set entrySet {
overview
"explicit group version"
"group version filter"
"explicit file"
"file filter"
"item filter"
}
set sysV [[$this groupV] getParent SystemVersion]
set phaseV [$sysV getParent PhaseVersion]
if {"[$phaseV getInfo Type]" != "Implementation"} {
set entrySet [linsert $entrySet 5 "file selector"]
append entrySet { "item selector"}
}
$this.top.mode.optmenu entrySet $entrySet
$this modeChanged
$this config \
-modal [$this editable] \
-title "[$this title] - [[$this groupV] getInfo Name]"
$this TemplateDialog::popUp
if {"$errorMsg" != ""} {
global errorInfo errorCode
set errorInfo $errorTrace
set errorCode $errorCodeCopy
wmtkerror $errorMsg
}
}
method GroupVStrDlg::removeObjects {this} {
set groupV [$this groupV]
case "[$this currentMode]" in {
{"explicit group version"} {
set sysV [$groupV getParent SystemVersion]
$this listDialog \
"[$groupV explicitSubgroupVersions $sysV]" \
"Delete Explicit Subgroup" \
"There are no explicit subgroup versions \
within this group version" \
removeExplicitSubgroup \
""
}
{"group version filter"} {
$this listDialog \
"[$groupV subgroupFilters]" \
"Delete Subgroup Filter" \
"There are no subgroup filters within this group version" \
"removeFilter" \
""
}
{"explicit file"} {
$this listDialog \
"[$groupV explicitFiles]" \
"Delete Explicit File" \
"There are no explicit files within this group version" \
removeExplicitFile \
""
}
{"file filter"} {
$this listDialog \
"[$groupV fileFilters]" \
"Delete File Filter" \
"There are no file filters within this group version" \
"removeFilter" \
""
}
{"file selector"} {
$this listDialog \
"[$groupV fileSelectors]" \
"Delete File Selector" \
"There are no file selectors within this group version" \
"removeFileSelector" \
""
}
{"item filter"} {
$this listDialog \
"[$groupV itemFilters]" \
"Delete Item Filter" \
"There are no item filters within this group version" \
"removeFilter" \
""
}
{"item selector"} {
$this listDialog \
"[$groupV itemSelectors]" \
"Delete Item Selector" \
"There are no item selectors within this group version" \
"removeItemSelector" \
""
}
}
}
method GroupVStrDlg::showObjects {this} {
set groupV [$this groupV]
case "[$this currentMode]" in {
{"group version filter"} {
$this listDialog \
"[$groupV subgroupFilters]" \
"Show Subgroup Filter" \
"There are no subgroup filters within this group version" \
"" \
"filterSubgroupVersions"
}
{"file filter"} {
$this listDialog \
"[$groupV fileFilters]" \
"Show File Filter" \
"There are no file filters within this group version" \
"" \
"filterFileVersions"
}
{"item filter"} {
$this listDialog \
"[$groupV itemFilters]" \
"Show Item Filter" \
"There are no item filters within this group version" \
"" \
"filterItems"
}
}
}
method GroupVStrDlg::showObjectsOk {this repObjList save} {
if $save {
$this currentRepObjList $repObjList
}
# Remove rows
foreach object [$this.top.view objectSet] {
$object delete
}
# Create new rows
set count 0
foreach repObj $repObjList {
$repObj initializeInfo ""
set browserType [$repObj browserType]
set repType [$repObj uiClass]
set typeSpec [getObjectSpec [.main objectHdlr] $repType $browserType]
if {"$typeSpec" == ""} continue
set details [list "[$repObj getInfo Type]"]
lappend details "[$repObj getInfo Status]"
BrowsObject new $this.top.view.object$count \
-smallIcon [$typeSpec smallIcon] \
-label "[$repObj getInfo Name]" \
-selectState 0 \
-details "$details"
incr count 1
}
# Sort the view
set sortSpec "\
-column {$this.top.view.header1 ascii increasing} \
-column {$this.top.view.header0 ascii increasing} \
-column {$this.top.view.header2 ascii increasing}"
eval $this.top.view sort $sortSpec
}
# Do not delete this line -- regeneration end marker