00001 # Copyright (C) 1997-2004 The CDG Team <cdg@nats.informatik.uni-hamburg.de> 00002 # 00003 # This file is free software; as a special exception the author gives 00004 # unlimited permission to copy and/or distribute it, with or without 00005 # modifications, as long as this notice is preserved. 00006 # 00007 # This program is distributed in the hope that it will be useful, but 00008 # WITHOUT ANY WARRANTY, to the extent permitted by law; without even the 00009 # implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 00010 00011 ## ---------------------------------------------------------------------------- 00012 ## CdgBusy - dialog indicating work in progress. 00013 ## This class is used to display a dialog while a computational intensive operation 00014 ## is scheduled in the background. It stays open as long as the bacground computation has 00015 ## no finished. The user is given an "interrupt" button to signal the background computation 00016 ## that it might terminate earlier. Actually to let the user do that the background 00017 ## computation has to be written cooperatively as we have no real concurrency in tcl. 00018 ## This is accomplished by a frequent call to "update" somewhere in your computation 00019 ## loop. 00020 ## 00021 ## The busy dialog should also be closed in case of any errors. This is accomplished 00022 ## by overwriting the tcl commands "error", "catch" and "bgerror" in \ref error.tcl. 00023 ## 00024 ## \author Michael Daum (see also AUTHORS and THANKS for more) 00025 ## $Id: busy.tcl,v 1.24 2004/10/11 15:23:31 micha Exp $ 00026 ## ---------------------------------------------------------------------------- 00027 class CdgBusy { 00028 inherit itk::Widget 00029 00030 # public methods 00031 public method compute {text args}; ## \type TclString, TclList 00032 public method interrupt {args}; ## \type TclList 00033 # public variables 00034 public variable wait 500 00035 00036 constructor {args} {}; ## \type TclList 00037 00038 # private methods 00039 private method blink {} 00040 private method reset {} 00041 private method enterAction {w x y}; ## \type TclWidget, TclNumber, TclNumber 00042 private method leaveAction {} 00043 00044 # private variables 00045 private variable computeText ""; ## \type TclString 00046 private variable oldCursor ""; ## \type TclString 00047 private variable ledState 0; ## \type Boolean 00048 private variable isActive 0; ## \type Boolean 00049 private variable blinkJob ""; ## \type AfterJob 00050 }; 00051 00052 00053 ## ---------------------------------------------------------------------------- 00054 ## constructor 00055 ## ---------------------------------------------------------------------------- 00056 body CdgBusy::constructor {args} { 00057 global env 00058 00059 set isActive 0 00060 set ledState 0 00061 00062 image create photo led_off -file $env(XCDG_LIB)/g_grey.gif 00063 image create photo led_on -file $env(XCDG_LIB)/g_red_on.gif 00064 00065 itk_component add intButton { 00066 button $itk_interior.intButton\ 00067 -anchor w \ 00068 -image led_off \ 00069 -command [code $this interrupt] \ 00070 -state disabled \ 00071 -relief flat 00072 } { 00073 keep -font -background -foreground 00074 } 00075 00076 pack $itk_component(intButton) -side right 00077 00078 eval itk_initialize $args 00079 } 00080 00081 ## ---------------------------------------------------------------------------- 00082 ## execute the command. 00083 ## This method first shows the dialog and the spawns an \c after _compute(). 00084 ## \param text the message to be displayed in the dialog 00085 ## \param args the script to be computed. 00086 ## \returns the return value of the evaluated script 00087 ## ---------------------------------------------------------------------------- 00088 body CdgBusy::compute {text args} { 00089 global _errorFlag 00090 00091 00092 if {$isActive > 0} { 00093 cmd::Puts "ERROR: cannot execute \n$text" 00094 return 00095 } 00096 00097 set _errorFlag 0 00098 cdgCtrlCAllowed_set 1 00099 .cdgmain help showstr $text 00100 set computeText $text 00101 bind $itk_interior <Enter> [code $this enterAction %W %X %Y] 00102 bind $itk_interior <Leave> [code $this leaveAction] 00103 00104 set isActive 1 00105 set oldCursor [. cget -cursor] 00106 $itk_component(intButton) configure -state normal 00107 . configure -cursor watch 00108 update idletask 00109 00110 set blinkJob [after idle [code $this blink]] 00111 update idletask 00112 set result [uplevel $args] 00113 reset 00114 return $result 00115 } 00116 00117 ## ---------------------------------------------------------------------------- 00118 ## interrupt the current computation. 00119 ## ---------------------------------------------------------------------------- 00120 body CdgBusy::interrupt {args} { 00121 global _errorFlag 00122 00123 if {$isActive <= 0} { 00124 return 00125 } 00126 00127 if {[cdgCtrlCAllowed_get]} { 00128 ::cmd::Puts "WARNING: Interrupt received, wait a moment ..." 00129 cdgCtrlCTrapped_set 1 00130 incr isActive -1 00131 if {$isActive <= 0 || $_errorFlag} { 00132 reset 00133 } 00134 } else { 00135 ::cmd::Puts "WARNING: Interrupt suppressed, try later." 00136 } 00137 } 00138 00139 ## ---------------------------------------------------------------------------- 00140 ## indicate computation 00141 ## ---------------------------------------------------------------------------- 00142 body CdgBusy::blink {} { 00143 if {$ledState} { 00144 $itk_component(intButton) configure -image led_off 00145 set ledState 0 00146 } else { 00147 $itk_component(intButton) configure -image led_on 00148 set ledState 1 00149 } 00150 00151 set blinkJob [after 1000 [code $this blink]] 00152 update idletask 00153 } 00154 00155 ## ---------------------------------------------------------------------------- 00156 ## reset the blinker to a normal state. 00157 ## ---------------------------------------------------------------------------- 00158 body CdgBusy::reset {} { 00159 set isActive 0 00160 . configure -cursor $oldCursor 00161 .cdgmain help showstr "" 00162 if {$blinkJob != ""} { 00163 after cancel $blinkJob 00164 } 00165 $itk_component(intButton) configure -state disabled -image led_off 00166 set ledState 0 00167 set blinkJob "" 00168 set oldCursor "" 00169 set computeText "" 00170 bind $itk_interior <Enter> "" 00171 .cdgmain balloon off 00172 } 00173 00174 ## ---------------------------------------------------------------------------- 00175 ## display the busy balloon. 00176 ## This slot is connected to the <Enter> event. 00177 ## ---------------------------------------------------------------------------- 00178 body CdgBusy::enterAction {w x y} { 00179 .cdgmain balloon on $x $y $computeText 00180 } 00181 00182 ## ---------------------------------------------------------------------------- 00183 ## disable the busy balloon. 00184 ## This slot is connected to the <Leave> event. 00185 ## ---------------------------------------------------------------------------- 00186 body CdgBusy::leaveAction {} { 00187 .cdgmain balloon off 00188 }