home *** CD-ROM | disk | FTP | other *** search
- #---------------------------------------------------------------------------
- #
- # (c) Cayenne Software Inc. 1997
- #
- # File: @(#)ctrlpnldia.tcl /main/titanic/8
- # Author: <generated>
- # Description:
- #---------------------------------------------------------------------------
- # SccsId = @(#)ctrlpnldia.tcl /main/titanic/8 23 Oct 1997 Copyright 1997 Cayenne Software Inc.
-
- # Start user added include file section
- require "ctrlpnlvie.tcl"
- require "custfileut.tcl"
- # End user added include file section
-
- require "duallook.tcl"
-
- Class CtrlPnlDialog : {DualLook TemplateDialog} {
- method destructor
- constructor
- method newableObjectList
- method newObjects
- method addObjects
- method removeObjects
- method removeEntry
- method insertEntryAfter
- method showResult
- method popUp
- method quit
- method save
- method registerObject
- method getSpec
- method checkButtons
- method view
- attribute cadEntries
- attribute codEntries
- attribute stdEntries
- attribute dfdEntries
- attribute etdEntries
- attribute mgdEntries
- attribute ccdEntries
- attribute ucdEntries
- attribute entrySet
- attribute lvlObj
- attribute fileName
- attribute fileType
- attribute editable
- attribute number
- attribute _view
- }
-
- method CtrlPnlDialog::destructor {this} {
- set ref [$this _view]
- if {$ref != ""} {
- $ref _dialog ""
- }
- # Start destructor user section
- # End destructor user section
- $this DualLook::destructor
- }
-
- constructor CtrlPnlDialog {class this name} {
- set this [TemplateDialog::constructor $class $this $name]
- $this DualLook::initialize
-
- $this cadEntries {cad_class link_attr_box cad_container nary_assoc
- note Vertex more_classes association aggregation
- qualif_assoc qualif_aggr nary_assoc_conn constraint
- generalization_conn overlap_gen_conn loop
- note_conn propagation
- Select}
-
- $this codEntries {
- cod_actor instance nary_link note Vertex note_conn link
- aggr_link qualif_link qualif_aggr_link bfsldmsg ffsldmsg
- bfstkmsg ffstkmsg bhstkmsg fhstkmsg nary_link_conn Select
- }
-
- $this stdEntries {name_state state super_state
- start_state final_state
- history_state ver_state_sep hor_state_sep
- ver_compl_trans hor_compl_trans std_class
- note Vertex transition
- event_msg note_conn Select}
-
- $this dfdEntries {data_proc data_store dfd_actor dfd_anchor note Vertex
- data_flow result_flow ctrl_flow update_flow
- note_conn Select}
-
- $this etdEntries {
- etd_initiator etd_object etd_timing_constr note Vertex
- etd_event etd_flat etd_async etd_return note_conn
- in_scope_region object_termination Select
- }
-
-
- $this mgdEntries {message_def note Vertex message_gen_conn note_conn Select}
-
- $this ccdEntries {ccd_class ccd_class_ref ccd_container ccd_actor
- subject note Vertex com_message note_conn Select}
-
- $this ucdEntries {use_case ucd_actor note Vertex
- und_com_assoc dir_com_assoc use_case_gen note_conn Select}
-
- ClassMaker::extend BrowsObject CtrlPnlObj {index id}
-
- global classCount
- incr classCount
- $this number $classCount
-
- $this config \
- -cancelPressed { %this quit } \
- -okPressed { %this save } \
- -helpPressed {.main helpOnName ctrlPnlDialog}
-
- interface DlgColumn $this.top {
- DlgRow menu {
- verStretchFactor 0
- verShrinkFactor 0
- horStretchFactor 0
- verStretchFactor 0
- PushButton new {
- label New...
- }
- PushButton test {
- label Test...
- }
- PushButton delete {
- label Delete
- }
- }
- Label contentsLab {
- text "Contents:"
- alignment CENTER
- }
- CtrlPnlView view {
- rowCount 10
- mode DETAIL
- BrowsHeader header0 {
- label Name
- width 30
- }
- }
- HorRadioGroup colCountHRG {
- entrySet {"one column" "two columns" "three columns"}
- justification CENTER
- }
- }
-
- $this.top.menu.new activated [list $this newObjects]
- $this.top.menu.test activated [list $this showResult]
- $this.top.menu.delete activated [list $this removeObjects]
-
- $this view $this.top.view
- $this modal Yes
-
- $this.top.view selectionChanged "$this checkButtons"
-
- return $this
- }
-
- method CtrlPnlDialog::newableObjectList {this} {
-
- set allEntries [$this [$this fileName]Entries]
- set newEntries [$this supportedSymbolSet [$this fileName] $allEntries]
-
- foreach obj [[$this view] objectSet] {
- set name [$obj label]
- set idx [lsearch -exact $newEntries $name]
- if {$idx != -1} {
- # does already exist so it can not be newed
- set newEntries [lreplace $newEntries $idx $idx]
- }
- }
- return $newEntries
- }
-
- method CtrlPnlDialog::newObjects {this} {
-
- set newEntries [$this newableObjectList]
-
- set box .main.panelListDialog[$this number]
- if {! [isCommand $box]} {
- ListDialog new $box \
- -modal Yes \
- -title "New Panel Entry" \
- -selectionPolicy EXTENDED \
- -rowCount 12 \
- -okPressed "$this addObjects \[%this selectedSet\]" \
- -helpPressed {.main helpOnName ctrlPnlNew}
- }
- $box entrySet $newEntries
- $box popUp
- }
-
- method CtrlPnlDialog::addObjects {this names} {
- set entrySet [$this entrySet]
- foreach name $names {
- if { [lsearch -exact $entrySet $name] == -1 } {
- lappend entrySet $name
- }
- }
- $this entrySet $entrySet
-
- foreach name [$this supportedSymbolSet [$this fileName] $names] {
- set object [$this view].object$name
- set interfaceName [$this convertSymbolSet [$this fileName] $name]
- CtrlPnlObj new $object \
- -smallIcon $interfaceName \
- -largeIcon $interfaceName \
- -label $name \
- -selectState 0 \
- -id $object
- if [$this editable] {
- $object conversionSet "CONTROLPANELENTRY id"
- }
- }
- [$this view] reIndex
- $this checkButtons
- }
-
- method CtrlPnlDialog::removeObjects {this} {
- foreach obj [[$this view] selectedSet] {
- $this removeEntry [$obj label]
- $obj delete
- }
- [$this view] reIndex
- $this checkButtons
- }
-
- method CtrlPnlDialog::removeEntry {this name} {
- set entrySet [$this entrySet]
- set index [lsearch -exact $entrySet $name]
- set entrySet [lreplace $entrySet $index $index]
- $this entrySet $entrySet
- }
-
- method CtrlPnlDialog::insertEntryAfter {this after name} {
- set entrySet [$this entrySet]
- if { $after == "" } {
- lappend entrySet $name
- } else {
- set index [expr [lsearch -exact $entrySet $after] + 1]
- set entrySet [linsert $entrySet $index $name]
- }
-
- $this entrySet $entrySet
- }
-
- method CtrlPnlDialog::showResult {this} {
-
- if [isCommand .main.showPanel[$this number]] {
- .main.showPanel[$this number] popDown
- .main.showPanel[$this number] delete
- }
-
- interface TemplateDialog .main.showPanel[$this number] {
- modal Yes
- DlgColumn DC {
- VerControlPanel VCP {
- }
- }
- }
- .main.showPanel[$this number] delCancelButton
-
- set spec [$this getSpec]
- set entrySet [$this supportedSymbolSet [$this fileName] [lindex $spec 0]]
- .main.showPanel[$this number].DC.VCP config \
- -entrySet $entrySet \
- -columnCount [lindex $spec 1]
- .main.showPanel[$this number] config \
- -title [$this title] \
- -okPressed {%this delete} \
- -helpPressed {.main helpOnName ctrlPnlTest}
- .main.showPanel[$this number] popUp
- }
-
- method CtrlPnlDialog::popUp {this} {
-
- eval "proc registerObject {spec} {$this registerObject \$spec}"
- CustFileUtilities::read [$this lvlObj] [$this fileName] [$this fileType]
-
- $this title "'[string toupper [$this fileName]]' Control Panel"
- $this TemplateDialog::popUp
-
- $this.top.menu.new sensitive [$this editable]
- $this.top.menu.delete sensitive [$this editable]
- $this.top.colCountHRG sensitive [$this editable]
-
- if {"[$this lvlObj]" == ""} return
- if [[$this lvlObj] isA Corporate] return
-
- set custFV [[$this lvlObj] findCustomFileVersion \
- [$this fileName] [$this fileType]]
- if [$custFV isNil] return
-
- if [$this editable] {
- if [catch {$custFV edit} msg] {
- wmtkerror $msg
- $this.top.menu.new sensitive 0
- $this.top.menu.delete sensitive 0
- $this.top.colCountHRG sensitive 0
- }
- }
-
- $this checkButtons
- }
-
- method CtrlPnlDialog::quit {this} {
-
- if {"[$this lvlObj]" == ""} return
- if [[$this lvlObj] isA Corporate] return
-
- set custFV [[$this lvlObj] findCustomFileVersion \
- [$this fileName] [$this fileType]]
- if [$custFV isNil] return
-
- if [$this editable] {
- $custFV quit
- }
- }
-
- method CtrlPnlDialog::save {this} {
-
- if {![$this editable]} {
- return
- }
-
- set tmpFile [args_file {}]
- set fid [open $tmpFile w]
-
- set spec [$this getSpec]
- set objSpec "entrySet \"[lindex $spec 0]\""
- set objSpec "$objSpec columnCount \"[lindex $spec 1]\""
- puts $fid "registerObject \{$objSpec\}"
- close $fid
- CustFileUtilities::save $tmpFile \
- [$this lvlObj] [$this fileName] [$this fileType]
- unlink $tmpFile
-
- $this quit
- }
-
- method CtrlPnlDialog::registerObject {this objSpec} {
-
- while {![lempty $objSpec]} {
- set key [lvarpop objSpec]
- set value [lvarpop objSpec]
-
- if {$key == "entrySet"} {
- $this entrySet $value
- $this addObjects $value
- }
-
- if {$key == "columnCount"} {
- if {$value == 1} {
- $this.top.colCountHRG selected "one column"
- } elseif {$value == 2} {
- $this.top.colCountHRG selected "two columns"
- } elseif {$value == 3} {
- $this.top.colCountHRG selected "three columns"
- }
- }
- }
- }
-
- method CtrlPnlDialog::getSpec {this} {
-
- set columnCount 1
-
- set selected [$this.top.colCountHRG selected]
- if {$selected == "two columns"} {
- set columnCount 2
- } elseif {$selected == "three columns"} {
- set columnCount 3
- }
-
- return [list [$this entrySet] $columnCount]
- }
-
- method CtrlPnlDialog::checkButtons {this} {
-
- if ![$this editable] {
- # disabled stays disabled
- return
- }
-
- if [lempty [[$this view] selectedSet]] {
- $this.top.menu.delete sensitive 0
- } else {
- $this.top.menu.delete sensitive 1
- }
-
-
- if [lempty [$this newableObjectList]] {
- $this.top.menu.new sensitive 0
- } else {
- $this.top.menu.new sensitive 1
- }
- }
-
- # Do not delete this line -- regeneration end marker
-
- method CtrlPnlDialog::view {this args} {
- if {$args == ""} {
- return [$this _view]
- }
- set ref [$this _view]
- if {$ref != ""} {
- $ref _dialog ""
- }
- set obj [lindex $args 0]
- if {$obj != ""} {
- $obj _dialog $this
- }
- $this _view $obj
- }
-
-