home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / wmttool.tcl < prev    next >
Text File  |  1997-11-24  |  15KB  |  561 lines

  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1996
  4. #
  5. #      File:           @(#)wmttool.tcl    /main/titanic/12
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)wmttool.tcl    /main/titanic/12   24 Nov 1997 Copyright 1996 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12.  
  13. require command.tcl
  14. require classmaker.tcl
  15. require wmt_util.tcl
  16.  
  17. # End user added include file section
  18.  
  19. require "communicat.tcl"
  20.  
  21. # Definition of class WmtTool which is a base class
  22. # for tools that are able to start exetools.
  23.  
  24. Class WmtTool : {Communicator} {
  25.     method destructor
  26.     constructor
  27.     method watchdogBusy
  28.     method ready
  29.     method selectedIdSet
  30.     method selectedNameTypeSet
  31.     method startDispatcher
  32.     method startCommand
  33.     method startCommandWithOptions
  34.     method startM4Command
  35.     method startDocbatch
  36.     method startExetool
  37.     method toolBarPresent
  38.     method contextAreaPresent
  39.     method messageAreaPresent
  40.     method addToolBar
  41.     method addContextArea
  42.     method addMessageArea
  43.     method updateToolBar
  44.     method updateWmtArea
  45.     method setToolBarPresence
  46.     method saveToolBarPresence
  47.     method setContextAreaPresence
  48.     method saveContextAreaPresence
  49.     method setMessageAreaPresence
  50.     method saveMessageAreaPresence
  51.     method setWindowGeometry
  52.     method saveWindowGeometry
  53.     method addActiveCmd
  54.     method removeActiveCmd
  55.     method addMtoolPending
  56.     method removeMtoolPending
  57.     method addXtoolPending
  58.     method removeXtoolPending
  59.     attribute dispatcher
  60.     attribute _watchdogBusy
  61.     attribute exitButton
  62.     attribute exitStatusList
  63.     attribute caller
  64.     attribute notSavedM4Vars
  65.     attribute _selectedIdSet
  66.     attribute _selectedNameTypeSet
  67.     attribute activeCmdSet
  68.     attribute mtoolPendingSet
  69.     attribute xtoolPendingSet
  70. }
  71.  
  72. method WmtTool::destructor {this} {
  73.     # Start destructor user section
  74.  
  75.     set dispatcher [$this dispatcher]
  76.     if {$dispatcher != ""} {
  77.         send -async $dispatcher \
  78.         ClDispatcher::unregisterClient [list [get_comm_name]]
  79.     }
  80.     set notSaved [$this notSavedM4Vars]
  81.     m4_var foreach m4var {
  82.         foreach varSpec $notSaved {
  83.             if [string match $varSpec $m4var] {
  84.                 m4_var saveStatus $m4var 0
  85.             }
  86.         }
  87.     }
  88.     m4_var save
  89.     # End destructor user section
  90.     $this Communicator::destructor
  91. }
  92.  
  93. constructor WmtTool {class this name} {
  94.     set this [Communicator::constructor $class $this $name]
  95.  
  96.     $this config \
  97.     -activeCmdSet [List new] \
  98.     -mtoolPendingSet [List new] \
  99.     -xtoolPendingSet [List new] \
  100.     -_watchdogBusy 0 \
  101.     -notSavedM4Vars {
  102.         M4_corproles__*
  103.         M4_projroles__*
  104.         M4_levelpath*
  105.         M4_parent_pid
  106.     }
  107.     global wmttoolObj
  108.     set wmttoolObj $this
  109.  
  110.     $this startDispatcher
  111.  
  112.     return $this
  113. }
  114.  
  115. proc WmtTool::dispatcherStarted {dispatcher} {
  116.     $wmttoolObj dispatcher $dispatcher
  117. }
  118.  
  119. proc WmtTool::externCmdFailed {cmd obj} {
  120.     foreach exitStatus [$wmttoolObj exitStatusList] {
  121.     if $exitStatus {
  122.         wmtkmessage "Executing '$cmd' for '$obj' failed"
  123.         break
  124.     }
  125.     }
  126. }
  127.  
  128. proc WmtTool::mtoolAvailable {mtool cmd {dir ""}} {
  129.     set this $wmttoolObj
  130.     set list [$this mtoolPendingSet]
  131.     $list removeValue $cmd
  132.     $this addActiveCmd $cmd
  133.     $cmd execute $mtool $dir
  134. }
  135.  
  136. proc WmtTool::xtoolAvailable {xtool cmd {dir ""}} {
  137.     set this $wmttoolObj
  138.     set list [$this xtoolPendingSet]
  139.     $list removeValue $cmd
  140.     $this addActiveCmd $cmd
  141.     $cmd execute $xtool $dir
  142. }
  143.  
  144.  
  145. # This callback function is called when an exetool
  146. # has been started.
  147. #
  148. proc WmtTool::exetoolStarted {clientId} {
  149.     wmtkmessage ""
  150. }
  151.  
  152.  
  153. # This callback function is called when an exetool
  154. # is finished with the execution of command(s).
  155. #
  156. proc WmtTool::exetoolFinished {clientId exitStatusList} {
  157.     set this $wmttoolObj
  158.     $this exitStatusList $exitStatusList
  159.     $this removeActiveCmd $clientId
  160.     $clientId delete
  161. }
  162.  
  163. method WmtTool::watchdogBusy {this {flag ""}} {
  164.     if {"$flag" != ""} {
  165.     set watchdogBusy [$this _watchdogBusy]
  166.     if $flag {
  167.         incr watchdogBusy 1
  168.     } else {
  169.         incr watchdogBusy -1
  170.     }
  171.     $this _watchdogBusy $watchdogBusy
  172.     if {"[$this exitButton]" != ""} {
  173.         if {$watchdogBusy > 0} {
  174.         [$this exitButton] sensitive 0
  175.         wmtkmessage ""
  176.         } else {
  177.         [$this exitButton] sensitive 1
  178.         $this exitStatusList {}
  179.         }
  180.     }
  181.     }
  182.     return [$this _watchdogBusy]
  183. }
  184.  
  185. method WmtTool::ready {this} {
  186.     set caller [$this caller]
  187.     if {"$caller" != "" && [isRunning $caller]} {
  188.     send -async $caller {wmtkmessage ""}
  189.     }
  190. }
  191.  
  192. method WmtTool::selectedIdSet {this} {
  193.     set selectedIdSet [$this _selectedIdSet]
  194.     if {"$selectedIdSet" == "undefined"} {
  195.     set selectedIdSet ""
  196.     set selection [concat \
  197.         [[$this treeView] selected] \
  198.         [[$this flatView] selectedSet] \
  199.     ]
  200.     foreach obj $selection {
  201.         lappend selectedIdSet [[$obj browsUiObj] getInfo Identity]
  202.     }
  203.     $this _selectedIdSet $selectedIdSet
  204.     }
  205.     return $selectedIdSet
  206. }
  207.  
  208. method WmtTool::selectedNameTypeSet {this} {
  209.     set selectedNameTypeSet [$this _selectedNameTypeSet]
  210.     if {"$selectedNameTypeSet" == "undefined"} {
  211.     set selectedNameTypeSet ""
  212.     set selection [concat \
  213.         [[$this treeView] selected] \
  214.         [[$this flatView] selectedSet] \
  215.     ]
  216.     foreach obj $selection {
  217.         set browsUiObj [$obj browsUiObj]
  218.         if [$browsUiObj isA ExternalFileVersion] {
  219.         lappend selectedNameTypeSet "[$browsUiObj getInfo Path]"
  220.         } elseif [$browsUiObj isA DocSection] {
  221.         lappend selectedNameTypeSet "[$browsUiObj getInfo Path]"
  222.         } else {
  223.         lappend selectedNameTypeSet \
  224.             "[$browsUiObj getInfo Name].[$browsUiObj getInfo Type]"
  225.         }
  226.     }
  227.     $this _selectedNameTypeSet $selectedNameTypeSet
  228.     }
  229.     return $selectedNameTypeSet
  230. }
  231.  
  232. method WmtTool::startDispatcher {this} {
  233.     # Start dispatcher if not running. We really need to lock the
  234.     # interpreter registry some how, since this is full of raise conditions.
  235.     wmtkmessage "Starting dispatcher..."
  236.     set disp ""
  237.     set dispInterp [lrange [lreplace [get_comm_name] 0 0 dispatcher] 0 2]
  238.     foreach tool [interps] {
  239.     if {$dispInterp == [lrange $tool 0 2] && [isRunning $tool]} {
  240.         set disp $tool
  241.         send -async $tool \
  242.             ClDispatcher::registerClient [list [get_comm_name]]
  243.         break
  244.     }
  245.     }
  246.     if {$disp == ""} {
  247.     SystemUtilities::fork otk dispatcher "[get_comm_name]"
  248.     }
  249.     $this dispatcher $disp
  250.     wmtkmessage "Done"
  251. }
  252.  
  253. method WmtTool::startCommand {this type cmd endCmd msg upd busy {dir ""}} {
  254.     case $type in {
  255.     {mtool xtool} {
  256.         set dispatcher [$this dispatcher]
  257.         if {"$dispatcher" == ""} {
  258.         wmtkerror "Dispatcher can not be started or is not running yet"
  259.         return
  260.         }
  261.         if {! [isRunning $dispatcher]} {
  262.         wmtkerror "Dispatcher is not running: starting new one"
  263.         $this startDispatcher
  264.         return
  265.         }
  266.     }
  267.     }
  268.  
  269.     set command [Command new $this \
  270.     -type $type \
  271.     -script $cmd \
  272.     -finishScript $endCmd \
  273.     -message $msg \
  274.     -updateState $upd \
  275.     -viewUpdate $this \
  276.     -workCursor $busy]
  277.     case $type in {
  278.     mtool {
  279.         wmtkmessage "Starting Monitoring Window..."
  280.         $this addMtoolPending $command
  281.         send -async [$this dispatcher] \
  282.         ClDispatcher::getFreeMtool [list [get_comm_name]] $command $dir
  283.     }
  284.     xtool {
  285.         wmtkmessage "Starting Execution Window..."
  286.         $this addXtoolPending $command
  287.         send -async [$this dispatcher] \
  288.         ClDispatcher::getFreeXtool [list [get_comm_name]] $command $dir
  289.     }
  290.     default {
  291.         $command execute $dir
  292.     }
  293.     }
  294. }
  295.  
  296. method WmtTool::startCommandWithOptions {this type cmd endCmd msg upd busy {dir ""}} {
  297.     # Ask options first before starting command
  298.     set box $this.startCommandWithOptions
  299.     ClassMaker::extend EntryDialog OptionsEntryDialog \
  300.     {type cmdBefore cmdAfter endCmd msg upd busy dir}
  301.     # find the $OPTIONS string to determine the place of the options
  302.     set index [string first \$OPTIONS "$cmd"]
  303.     set cmdBefore "$cmd"
  304.     set cmdAfter ""
  305.     if {$index != -1} {
  306.     set cmdBefore [string range "$cmd" 0 [expr {$index -1}]]
  307.     set index [expr { $index + 9}]
  308.     set cmdAfter [string range "$cmd" $index end]
  309.     }
  310.     OptionsEntryDialog new $box \
  311.     -modal yes \
  312.     -title "Options for '$cmdBefore <options> $cmdAfter'" \
  313.     -type $type \
  314.     -cmdBefore $cmdBefore \
  315.     -cmdAfter $cmdAfter \
  316.     -endCmd $endCmd \
  317.     -msg $msg \
  318.     -upd $upd \
  319.     -busy $busy \
  320.     -dir $dir \
  321.     -cancelPressed {%this delete} \
  322.     -okPressed {
  323.         $wmttoolObj startCommand "[%this type]" \
  324.         "[%this cmdBefore] [%this entry] [%this cmdAfter]" "[%this endCmd]"\
  325.         "[%this msg]" "[%this upd]" "[%this busy]" "[%this dir]"
  326.         %this delete
  327.     }
  328.     $box delHelpButton
  329.     $box popUp
  330. }
  331.  
  332. method WmtTool::startM4Command {this m4Cmd m4CmdArgs endCmd obj {dir ""}} {
  333.     set command [m4_var get M4_[lindex $m4Cmd 0] -context [lindex $m4Cmd 1]]
  334.     if $win95 {
  335.     # always wincommand
  336.         set wincommand 1
  337.     } else {
  338.     set wincommand \
  339.         [m4_var get M4_win_[lindex $m4Cmd 0] -context [lindex $m4Cmd 1]]
  340.     }
  341.     if {"$wincommand" == "" || (! $wincommand)} {
  342.     set kind xtool
  343.     } else {
  344.     set kind extern
  345.     set endCmd \
  346.         "WmtTool::externCmdFailed [list $command] [list $obj] ; $endCmd"
  347.     }
  348.     if $win95 {
  349.     set script "$command \\\"$m4CmdArgs\\\""
  350.     } else {
  351.     set script "$command \"$m4CmdArgs\""
  352.     }
  353.     $this startCommand $kind \
  354.     "$script" "$endCmd" "Starting '$command' for '$obj'" \
  355.     {0 0} 0 $dir
  356. }
  357.  
  358. method WmtTool::startDocbatch {this type args endCmd upd busy {dir ""}} {
  359.     # redefined in docwriter module
  360. }
  361.  
  362. # Start an exetool (xtool or mtool).
  363. #
  364. method WmtTool::startExetool {this kind {dir ""}} {
  365.     if {! [$this isA MainWindow]} {
  366.     wmtkerror "Cannot start an exetool"
  367.     return
  368.     }
  369.     set box [format "%s.%s%s" "$this" "$kind" "Options"]
  370.     if {! [isCommand $box]} {
  371.     require "browseentr.tcl"
  372.     ClassMaker::extend BrowseEntryDlg ExetoolEntryDialog {kind dir}
  373.     case "$kind" in {
  374.         mtool {
  375.         set title "Monitoring Window Command(s)"
  376.         }
  377.         xtool {
  378.         set title "Execution Window Command(s)"
  379.         }
  380.     }
  381.     ExetoolEntryDialog new $box \
  382.         -modal yes \
  383.         -title $title \
  384.         -kind $kind \
  385.         -message "Command(s):" \
  386.         -okPressed {
  387.         $wmttoolObj startCommand [%this kind] \
  388.             "[%this entry]" "" "Starting '[%this entry]'..." \
  389.             {0 0} 0 [%this dir]
  390.         }
  391.     }
  392.     $box dir $dir
  393.     $box popUp
  394. }
  395.  
  396. method WmtTool::toolBarPresent {this show} {
  397.     if {$show} {
  398.         $this addToolBar
  399.         $this updateToolBar
  400.     } else {
  401.         if [isCommand [$this toolBar]] {
  402.             [$this toolBar] delete
  403.         }
  404.         [$this menuBar].view.menu.toolbar state 0
  405.     }
  406. }
  407.  
  408. method WmtTool::contextAreaPresent {this show} {
  409.     if {$show} {
  410.         $this addContextArea
  411.         [$this wmtArea] index 0
  412.         $this updateWmtArea
  413.     } else {
  414.         if [isCommand [$this wmtArea]] {
  415.             [$this wmtArea] delete
  416.             $this wmtArea ""
  417.         }
  418.     }
  419. }
  420.  
  421. method WmtTool::messageAreaPresent {this show} {
  422.     if {$show} {
  423.         $this addMessageArea
  424.     } else {
  425.         [$this messageArea] delete
  426.     }
  427. }
  428.  
  429. method WmtTool::addToolBar {this} {
  430.     if {![isCommand $this.toolBar]} {
  431.         ToolBar new $this.toolBar -justification FILLED
  432.     }
  433.     if [isCommand [$this menuBar].view.menu.toolbar] {
  434.         [$this menuBar].view.menu.toolbar state 1
  435.     }
  436. }
  437.  
  438. method WmtTool::addContextArea {this} {
  439.     # empty
  440. }
  441.  
  442. method WmtTool::addMessageArea {this} {
  443.     if {![isCommand $this.messageArea]} {
  444.         MessageArea new $this.messageArea
  445.     }
  446.     if [isCommand [$this menuBar].view.menu.messagearea] {
  447.         [$this menuBar].view.menu.messagearea state 1
  448.     }
  449. }
  450.  
  451. method WmtTool::updateToolBar {this} {
  452.     # empty
  453. }
  454.  
  455. method WmtTool::updateWmtArea {this} {
  456.     # empty
  457. }
  458.  
  459. method WmtTool::setToolBarPresence {this context} {
  460.     if [m4_var get M4_toolbar -context $context] {
  461.         $this addToolBar
  462.     } else {
  463.         if [isCommand $this.toolBar] {
  464.             [$this toolBar] delete
  465.         }
  466.         if [isCommand [$this menuBar].view.menu.toolbar] {
  467.             [$this menuBar].view.menu.toolbar state 0
  468.         }
  469.     }
  470. }
  471.  
  472. method WmtTool::saveToolBarPresence {this context} {
  473.     set barPresent [expr {[$this toolBar] != ""}]
  474.     if {$barPresent != [m4_var get M4_toolbar -context $context]} {
  475.         m4_var set M4_toolbar $barPresent -context $context
  476.     }
  477. }
  478.  
  479. method WmtTool::setContextAreaPresence {this context} {
  480.     if [m4_var get M4_contextarea -context $context] {
  481.         $this addContextArea
  482.     } else {
  483.         if [isCommand [$this wmtArea]] {
  484.             [$this wmtArea] delete
  485.             $this wmtArea ""
  486.         }
  487.         if [isCommand [$this menuBar].view.menu.contextarea] {
  488.             [$this menuBar].view.menu.contextarea state 0
  489.         }
  490.     }
  491. }
  492.  
  493. method WmtTool::saveContextAreaPresence {this context} {
  494.     set areaPresent [expr {[$this wmtArea] != ""}]
  495.     if {$areaPresent != [m4_var get M4_contextarea -context $context]} {
  496.         m4_var set M4_contextarea $areaPresent -context $context
  497.     }
  498. }
  499.  
  500. method WmtTool::setMessageAreaPresence {this context} {
  501.     if [m4_var get M4_messagearea -context $context] {
  502.         $this addMessageArea
  503.     } else {
  504.         if [isCommand $this.messageArea] {
  505.             $this.messageArea delete
  506.         }
  507.         if [isCommand [$this menuBar].view.menu.messagearea] {
  508.             [$this menuBar].view.menu.messagearea state 0
  509.         }
  510.     }
  511. }
  512.  
  513. method WmtTool::saveMessageAreaPresence {this context} {
  514.     set areaPresent [expr {[$this messageArea] != ""}]
  515.     if {$areaPresent != [m4_var get M4_messagearea -context $context]} {
  516.         m4_var set M4_messagearea $areaPresent -context $context
  517.     }
  518. }
  519.  
  520. method WmtTool::setWindowGeometry {this context} {
  521.     .main geometry [m4_var get M4_geometry -context $context]
  522. }
  523.  
  524. method WmtTool::saveWindowGeometry {this context} {
  525.     set geom [.main geometry]
  526.     if {$geom != [m4_var get M4_geometry -context $context]} {
  527.         m4_var set M4_geometry $geom -context $context
  528.     }
  529.  
  530. }
  531.  
  532. # Do not delete this line -- regeneration end marker
  533.  
  534. method WmtTool::addActiveCmd {this newActiveCmd} {
  535.     [$this activeCmdSet] append $newActiveCmd
  536.  
  537. }
  538.  
  539. method WmtTool::removeActiveCmd {this oldActiveCmd} {
  540.     [$this activeCmdSet] removeValue $oldActiveCmd
  541. }
  542.  
  543. method WmtTool::addMtoolPending {this newMtoolPending} {
  544.     [$this mtoolPendingSet] append $newMtoolPending
  545.  
  546. }
  547.  
  548. method WmtTool::removeMtoolPending {this oldMtoolPending} {
  549.     [$this mtoolPendingSet] removeValue $oldMtoolPending
  550. }
  551.  
  552. method WmtTool::addXtoolPending {this newXtoolPending} {
  553.     [$this xtoolPendingSet] append $newXtoolPending
  554.  
  555. }
  556.  
  557. method WmtTool::removeXtoolPending {this oldXtoolPending} {
  558.     [$this xtoolPendingSet] removeValue $oldXtoolPending
  559. }
  560.  
  561.