home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World 1998 October
/
PCWorld_1998-10_cd.bin
/
software
/
prehled
/
komix
/
DATA.Z
/
groupdialo.tcl
< prev
next >
Wrap
Text File
|
1997-11-19
|
16KB
|
613 lines
#---------------------------------------------------------------------------
#
# (c) Cayenne Software Inc. 1997
#
# File: @(#)groupdialo.tcl /main/titanic/4
# Author: <generated>
# Description:
#---------------------------------------------------------------------------
# SccsId = @(#)groupdialo.tcl /main/titanic/4 19 Nov 1997 Copyright 1997 Cayenne Software Inc.
# Start user added include file section
# End user added include file section
# Common functionality for group editor and
# gdr customization editor.
Class GroupDialog : {TemplateDialog} {
constructor
method destructor
method fileSelectorDialog
method filterDialog
method groupV
method itemSelectorDialog
method listDialog
method newObject
method removeObjects
method showObjects
method showObjectsOk
attribute editable
attribute currentMode
attribute currentRepObjList
attribute _groupV
attribute sysV
attribute phaseV
attribute confV
}
constructor GroupDialog {class this name} {
set this [TemplateDialog::constructor $class $this $name]
# 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
mode DETAIL
}
}
$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 GroupDialog::destructor {this} {
# Start destructor user section
if [$this editable] {
[$this groupV] quit
}
# End destructor user section
}
method GroupDialog::fileSelectorDialog {this msg} {
set fileTypes \
[lsort [concat [BrowserProcs::graphTypes] [BrowserProcs::matrixTypes]]]
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 GroupDialog::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 GroupDialog::groupV {this {groupV ""}} {
if {"$groupV" == ""} {
return [$this _groupV]
}
$this _groupV $groupV
set cc [ClientContext::global]
set sysV [$cc currentSystem]
$this sysV $sysV
set phaseV [$cc currentPhase]
$this phaseV $phaseV
set confV [$cc currentConfig]
$this confV $confV
}
method GroupDialog::itemSelectorDialog {this msg} {
set itemTypes {cl de et pe st}
set len [llength $itemTypes]
set fileTypes ""
set fTypes \
[lsort [concat [BrowserProcs::graphTypes] [BrowserProcs::matrixTypes]]]
foreach fileType $fTypes {
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 GroupDialog::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 GroupDialog::newObject {this} {
case "[$this currentMode]" in {
{"explicit group version"} {
set groupV [$this groupV]
set sysV [$this sysV]
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 [$this sysV]
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 GroupDialog::removeObjects {this} {
set groupV [$this groupV]
case "[$this currentMode]" in {
{"explicit group version"} {
set sysV [$this sysV]
$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 GroupDialog::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 GroupDialog::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