/* { - throw a priority abort so it can be caught - tooltips - tool buttons - status line - allow nvcheck to abort all operations at same time - popup menu on right click - check that count==limit at the end of the check - stretch refresh - clean up the fonts - progress windows could have fonts eliminated, i.e. system fonts - work on proper status - double titles on help pages - options - save the row widths etc. - 2.25. replace tktable with tablelist done --------------------------------------- - disable the progress - rejected - add scroll bars */ } /* { 2.28.0 When testing tcl 8.6 discovered that progress box updating is taking more time than expected. It takes much more than expected in tcl 8.4 and in fact takes aproximately twice as much time in tcl 8.6. This is possibly due to itcl 4.0 being much slower than itcl 3.4 but it could also be due to tcl 8.6 being slower than tcl 8.4. We don't know the relative factors. Here the idea is to speed things up by having the progress box call back for the done number, say once per second. Aborting: Before 2.28.0, operations check for abort each time they increment the progress box. We can instead do that once per second also. Checking for abort can be somewhat cumbersome so we have the progress bar do it once per second and make a separate callback on abort. */ } /* { The blue progress consists of a window with an operation per row. The operations are treated like a stack, being pushed when operation starts and popped on completion. When an operation is popped its row is cleared but not destroyed, so it is ready for the next operation to be pushed. This keeps the window size steadier and reduces the noise. If you want operations to remain on the screen to display that they completed, then use .destroy_skip 1. Blue progress windows can be aborted at any time by the user. One also presumes thet errors can occur at any time, resulting in the overall set of operations being aborted. In this case the window can be destroyed or not. It seems that they should most often be left on the screen as an indication of how far the operation progressed before the error occurred. The problem is that when an error occurs the exception will pass through the caller and the local will destroy the operation (unless .destroy_skip is 1). Abort Detection. Where you increment a progress operation is where you should check for an abort. If the progress window is aborted you typically do not need to explcitly destroy the operation. But you must throw an exception with .priority ignore. This will clean up the call stack and get you out. But someone on the call stack must eventually destroy the window, or else the user will have to do it. Operations should be created as locals so they are also wiped an operation , the size of the progress window is not reduced operation can leave itself displayed using .destroy_skip 1. Otherwise it is wiped out when it completes. The row the operation had occupied is left on the window to reduce noise but it ready to be occupied by the next operation. */ } ::qw::packages::package_require_tablelist; ::namespace eval ::qw::progress_blue {} ::if {[::llength [::itcl::find classes ::qw::dialog85::progress_blue]]!=0} { ::qw::try { ::itcl::delete class ::qw::dialog85::progress_blue; } catch Dummy {} } ::itcl::class ::qw::dialog85::progress_blue { /* { We are going to create only one of these objects and its name is "::qw::progress_blue_window" It is created on demand. 2.25.3 - this file replaced the original. Scrollbars ---------- Had dynamic scroll bars but had to turn off hsb to avoid infinite loop. The infinte loop occurred when additional lines put up programatically. Could not get infinite loop when resizing manually. So we can probably still use current mechanism for other windows. */ } inherit ::qw::dialog85::dialog_archetype; protected variable _table ""; protected variable _client ""; protected variable _data; protected variable _label_border_width 0.5m; protected variable _font {-family Arial -size 10 -weight normal}; protected variable _status_stack ""; protected variable _owner_tk_window ""; protected variable _default_background ""; protected variable _is_modeless 1; protected variable _column_definitions [::sargs]; protected variable _horizontal_scrollbar_is_enabled 0; common _unique_id 1; constructor {} { #::qw::dialog85::progress_blue ::array set _data {}; ::set Button [::button .button_3141201212031654421_temp]; ::set _default_background [$Button cget -background]; ::destroy $Button; } destructor { #::qw::dialog85::progress_blue ::incr ::qw::control(window_kickout_is_enabled) -1; options_store; ::foreach OperationId [::array names _data] { ::if {[::sargs::get $_data($OperationId) .tick_handle] ne ""} { ::after cancel [::sargs::get $_data($OperationId) .tick_handle]; } } } method main {sargs} { #::qw::dialog85::progress_blue ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,progress_blue,main,1000.0";} ::set _sargs $sargs; ::set _owner_tk_window [::sargs::get $sargs .owner_tk_window]; options_setup; ::sargs::var::+= _options $sargs; ::if {![has_help]} { ::sargs::var::unset _options .control_button.help; } ::if {$rwb1_debug} {::puts "rwb1_debug,progress_blue,main,1000.1";} toplevel_setup; ::if {$rwb1_debug} {::puts "rwb1_debug,progress_blue,main,1000.2";} menu_setup; ::if {$rwb1_debug} {::puts "rwb1_debug,progress_blue,main,1000.3";} toolbar_setup; ::if {$rwb1_debug} {::puts "rwb1_debug,progress_blue,main,1000.4";} control_button_setup; ::if {$rwb1_debug} {::puts "rwb1_debug,progress_blue,main,1000.5";} client_setup; ::if {$rwb1_debug} {::puts "rwb1_debug,progress_blue,main,1000.6";} popup_menu_setup; ::if {$rwb1_debug} {::puts "rwb1_debug,progress_blue,main,1000.7";} initialize; ::if {$rwb1_debug} {::puts "rwb1_debug,progress_blue,main,1000.8";} #dump_options; ::if {$_is_modeless} { ::if {$rwb1_debug} {::puts "rwb1_debug,progress_blue,main,1000.8.0";} ::if {!$::qw::control(progress_blue_raise_is_enabled)} { ::if {$rwb1_debug} {::puts "rwb1_debug,progress_blue,main,1000.9";} ::qw::toplevel_remove .toplevel $_toplevel; ::if {$rwb1_debug} {::puts "rwb1_debug,progress_blue,main,1000.10";} } ::return; } ::if {$rwb1_debug} {::puts "rwb1_debug,progress_blue,main,1000.11";} wait; ::if {$rwb1_debug} {::puts "rwb1_debug,progress_blue,main,1000.12";} ::set Result $_dialog_result; ::if {[::qw::command_exists $this]} { ::itcl::delete object $this; } ::if {$rwb1_debug} {::puts "rwb1_debug,progress_blue,main,1000.13";} ::return $Result; } method options_setup {} { #::qw::dialog85::dialog_blue chain; options_load; /* { Options we set here do not really vary so they aren't stored in the options file. */ } ::sargs::var::set _options .title "Progress"; } method options_load {} { /* { */ } ::set File [::file join $::qw_program_folder nv2.dat system progress_bar.qw_options]; ::set Options [::sargs::file::get $File]; ::if {[::sargs::size $Options]==0||[::sargs::size [::sargs::get $Options .column_definitions.fixed_count]]==0} { /* { 2.25.4 Had to add the check for fixed count field because it was added. */ } ::set Options { .column_definitions { .description { .name .description .title_text "Description" .align left .width 25 } .database_path { .name .database_path .title_text "File" .align left .width 25 } .state { .name .state .title_text "State" .align left .width 8 } .second_count { .name .second_count .title_text "Run Time" .align right .width 9 } .exception_count { .name .exception_count .title_text "Errors" .align right .width 6 } .fixed_count { .name .fixed_count .title_text "Fixed" .align right .width 6 } .limit { .name limit .title_text "Count" .align right .width 9 } .done_count { .name .done_count .title_text "Done" .align right .width 9 } .percent_done_graph { .name .percent_done_graph .title_text "Percent Done" .align center .width 25 } } } } ::set _column_definitions [::sargs::get $Options .column_definitions]; ::set _options $Options; ::if {[::sargs::exists $_column_definitions .file]} { ::foreach {Name Value} $_column_definitions { /* { 2.34.7 At some point in the past we changed the file field name from .file to .database_path. We also have to change the options. We do it on the fly right here. The field label title was left as "File" because it's already in screen shots and help. We have to go through a loop instead of just setting a new sargs field in the column_definitions because we want .database_path to replace .file in exactly the same order. */ } ::switch -- $Name { ".file" { ::sargs::var::set Value .name .database_path; ::sargs::var::set ColumnDefinitions .database_path $Value; } default { ::sargs::var::set ColumnDefinitions $Name $Value; } } } ::set _column_definitions $ColumnDefinitions; ::sargs::var::set _options .column_definitions $_column_definitions; } } method options_store {} { ::sargs::var::set Options .column_definitions $_column_definitions; ::sargs::var::set Options .qw_release $::qw_release; ::if {[::winfo exists $_toplevel]} { ::foreach Name [::sargs::names .structure $_column_definitions] { ::sargs::var::set _column_definitions $Name.width [$_table columncget $Name -width]; } } ::set Options [::sargs \ .column_definitions $_column_definitions \ .qw_release $::qw_release \ ]; ::if {[::winfo exists $_toplevel]} { ::sargs::var::set Options .toplevel.geometry [::wm geometry $_toplevel]; } ::set File [::file join $::qw_program_folder nv2.dat system progress_bar.qw_options]; ::sargs::file::set $File $Options; } method dump_options {sargs} { ::if {[::winfo exists $_table]} { ::foreach {Name Structure} $_column_definitions { ::puts "Field:$Name"; ::foreach Option { -align -background -changesnipside -editable -editwindow -font -foreground -formatcommand -hide -labelalign -labelbackground -labelborderwidth -labelcommand -labelcommand2 -labelfont -labelforeground -labelheight -labelimage -labelpady -labelrelief -maxwidth -name -resizable -selectbackground -selectforeground -showarrow -showlinenumbers -sortcommand -sortmode -stretchable -text -title -width -wrap } { ::puts "\t$Option: [$_table columnconfigure $Name $Option]"; } } } } method toplevel_setup {} { #::qw::dialog85::progress_blue chain; ::if {[::winfo exists $_toplevel]} { ::set Geometry [::sargs::get $_options .toplevel.geometry]; ::if {$Geometry ne ""} { ::wm geometry $_toplevel $Geometry; } } } method client_setup {sargs} { #::qw::dialog85::progress_blue chain $sargs; ::foreach Name [::sargs::names .structure $_column_definitions] { ::lappend ColumnOptionList \ [::sargs::integer_get $_column_definitions $Name.width] \ [::sargs::get $_column_definitions $Name.title_text] \ [::sargs::get $_column_definitions $Name.align] \ ; } ::frame $_toplevel.client -borderwidth 0 -relief flat -background white; ::frame $_toplevel.client.table_frame -borderwidth 0 -relief flat; ::set _table $_toplevel.client.table_frame.table; ::set _vsb $_toplevel.client.table_frame.vsb; # 2.230.0 - changed height from 5 to 8 to avoid gp (see jrp) ::if {$_horizontal_scrollbar_is_enabled} { ::set _hsb $_toplevel.client.table_frame.hsb; ::tablelist::tablelist $_table \ -columns $ColumnOptionList \ -height 8 \ -width 0 \ -background white \ -xscrollcommand [::list $_hsb set] \ -yscrollcommand [::list $_vsb set] \ -tooltipaddcommand [::itcl::code $this tablelist_tooltip_add_callback] \ -tooltipdelcommand ::DynamicHelp::delete \ ; } else { ::tablelist::tablelist $_table \ -columns $ColumnOptionList \ -height 8 \ -width 0 \ -background white \ -yscrollcommand [::list $_vsb set] \ -tooltipaddcommand [::itcl::code $this tablelist_tooltip_add_callback] \ -tooltipdelcommand ::DynamicHelp::delete \ ; } ::ttk::scrollbar $_vsb -orient vertical -command [::list $_table yview]; # ::ttk::scrollbar $_hsb -orient horizontal -command [::list $_table xview]; ::set Col 0; ::foreach Name [::sargs::names .structure $_column_definitions] { $_table columnconfigure $Col -name $Name; ::incr Col 1; } $_table configure -stretch [::list .percent_done_graph]; ::grid $_toplevel.client.table_frame.table -row 0 -column 0 -sticky news; ::grid $_vsb -row 0 -column 1 -sticky ns; ::if {$_horizontal_scrollbar_is_enabled} { ::grid $_hsb -row 1 -column 0 -sticky ew; } ::grid rowconfigure $_toplevel.client.table_frame 0 -weight 1 ::grid columnconfigure $_toplevel.client.table_frame 0 -weight 1 ::grid $_toplevel.client.table_frame -row 0 -column 1 -sticky nsew; ::grid rowconfigure $_toplevel.client 0 -weight 1; ::grid columnconfigure $_toplevel.client 1 -weight 1; ::pack $_toplevel.client -side top -expand 1 -fill both -padx 0 -pady 0; ::label $_toplevel.status \ -relief sunken \ -borderwidth $_label_border_width \ -anchor w \ -background $_default_background \ ; # ::pack $Client -side top -fill both -expand 1; # ::grid $_table -row 0 -column 0 -sticky news # ::grid $Client .vsb vsb -row 0 -column 1 -sticky ns; ::pack $_toplevel.status -side bottom -fill x -padx 4 -pady 4; } method toolbar_setup {sargs} { #::qw::dialog85::progress_blue chain $sargs; ::frame $_toplevel.toolbar_frame; # ::set Args [::sargs::get $::qw::options .window]; ::set ButtonList [::list]; ::lappend ButtonList [::sargs .text "Abort" .button .abort .command [::itcl::code $this command_process .command command_abort]]; ::lappend ButtonList [::sargs .text "Help" .button .help .command [::itcl::code $this command_process .command command_help]]; ::set Width 0; ::foreach s $ButtonList { /* { Make toolbar buttons as wide as the longest text line. */ } ::set Text [::sargs::get $s .text]; ::if {[::string length $Text]>$Width} { ::set Width [::string length $Text]; } } ::foreach s $ButtonList { /* { */ } ::set Button [::button $_toplevel.toolbar_frame[::sargs::get $s .button] \ -text [::sargs::get $s .text] \ -width $Width \ -font $_toolbar_button_font \ -relief ridge \ -overrelief raised \ -borderwidth .25m \ -command [::sargs::get $s .command] \ ]; ::pack $Button -fill y -side left -padx 2 -pady 2; } ::pack $_toplevel.toolbar_frame -side top -fill x -expand 0; } method control_button_setup {} { #::qw::dialog85::progress_blue chain; } method command_process {sargs} { #::qw::dialog85::progress_blue ::set Command [::sargs::get $sargs .command]; ::switch -- $Command { command_cancel { /* { */ } ::if {[operation_abort_query]} { ::itcl::delete object $this; } ::return; } command_exit { /* { */ } ::if {[operation_abort_query]} { ::itcl::delete object $this; } ::return; } command_abort { /* { */ } ::if {[::llength [operations_select .field .state .value "working"]]==0} { ::qw::throw \ .text "There is nothing to abort." \ .help_page { .id 314120091031095503 .tags {error} .body { [p { No operations are running so there is nothing to abort. An operation is running if the state column displays [qw_field_value working]. in the progress window. If the state is not [qw_field_value working] then the operation is finished, or it failed or was aborted. }] } } \ ; } ::if {[operation_abort_query]} { operation_abort .abort_query_skip 1; } ::return; } } chain $sargs; } method tablelist_tooltip_add_callback {Table Row Col} { /* { -tooltipaddcommand [::itcl::code $this tablelist_tooltip_add_callback] \ -tooltipdelcommand ::DynamicHelp::delete \ The classic tablelist tooltip help displays a tooltip for a cell that doesn't fit in it's column. And what the tooltip displays is the cell contents. We will do it this way: - title line displays toolip for column and title text if snipped - cells diplay cell text if snipped */ } ::set Field [$Table columncget $Col -name]; ::set CellText ""; ::set TooltipText ""; ::if {$Row<0} { /* { Title cell - display column tooltip, and optionally title text if snipped. Let's handle title row separately. */ } ::if {[$Table istitlesnipped $Col Temp]} { ::set CellText $Temp; } ::set TooltipText [::sargs::get [tooltip_get .path $Field] .text]; ::if {$CellText ne ""&&$TooltipText ne ""} { ::set Text "$CellText\n\n$TooltipText"; } else { ::set Text "$CellText$TooltipText"; } ::if {$Text ne ""} { ::DynamicHelp::add $Table -text $Text } ::return; } /* { Body cell - contents only and only when snipped. */ } ::if {[$Table iselemsnipped $Row,$Col Temp]} { ::set CellText $Temp; ::DynamicHelp::add $Table -text $CellText } } method tooltip_get {sargs} { #::qw::dialog85::progress_blue ::set Path [::sargs::get $sargs .widget]; ::if {$Path eq ""} { ::set Path [::sargs::get $sargs .path]; } ::set Text ""; ::switch -glob -- $Path { *.toolbar_frame.abort* { ::append Text "Abort currently running operation, if any."; ::return [::sargs .text $Text]; } *.toolbar_frame.help* { ::append Text "Help on progress bars."; ::append Text "\n(F1)"; ::return [::sargs .text $Text]; } *.description { ::append Text "Brief description of the operation."; ::return [::sargs .text $Text]; } *.database_path { ::append Text "Database associated with the operation."; ::return [::sargs .text $Text]; } *.state { ::append Text "working - Operation is still working."; ::append Text "\nsucceeded - Operation finished with all errors fixed."; ::append Text "\ncomplete - Operation finished but some errors not fixed."; ::append Text "\naborted - Operation was aborted by user."; ::return [::sargs .text $Text]; } *.second_count { ::append Text "Total time elapsed since start of operation."; ::append Text "\nElapsed time is in hhh:mm:ss format."; ::return [::sargs .text $Text]; } *.exception_count { ::append Text "Number or errors encountered, if any."; ::return [::sargs .text $Text]; } *.fixed_count { ::append Text "Number of errors fixed, if any."; ::return [::sargs .text $Text]; } *.limit { ::append Text "There are this many things to do."; ::return [::sargs .text $Text]; } *.done_count { ::append Text "This many things have been done so far."; ::return [::sargs .text $Text]; } *.percent_done_graph { ::append Text "Percent completion of things to do in the operation."; ::return [::sargs .text $Text]; } *.status { ::if {[::winfo exists $_toplevel.status]} { ::set Text [$_toplevel.status cget -text]; } else { ::set Text "Current status"; } ::return [::sargs .text $Text]; } *.help { ::append Text "Help on progress window."; ::append Text "\n(but not the running operation)."; ::return [::sargs .text $Text]; } *.abort { ::append Text "Abort currently running operation, if any." ::return [::sargs .text $Text]; } } ::return [chain $args]; } method operation_abort_query {sargs} { ::set rwb1_debug 0; ::set WorkingOperationIdList [operations_select .field .state .value "working"]; ::if {$rwb1_debug} {::puts "rwb1_debug,operation_abort_query,1000.0";} ::if {[::llength $WorkingOperationIdList]==0} { /* { If there are no working rows then there is nothing to abort so we return 1. No point in prompting the user. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,operation_abort_query,1000.1";} ::return 1; } ::if {[::sargs::boolean_get $sargs .abort_query_skip]} { ::if {$rwb1_debug} {::puts "rwb1_debug,operation_abort_query,1000.2";} ::return 1; } ::set OperationIdList [::list]; ::if {$rwb1_debug} {::puts "rwb1_debug,operation_abort_query,1000.3";} ::foreach OperationId $WorkingOperationIdList { ::set Handle [::sargs::get $_data($OperationId) .tick_handle]; ::if {$Handle ne ""} { ::after cancel $Handle; ::lappend OperationIdList $OperationId; } } ::if {$rwb1_debug} {::puts "rwb1_debug,operation_abort_query,1000.4";} ::set ClockSeconds [::clock seconds]; ::set Result [::qw::dialog85::confirm \ .title "Confirm that you want to abort operation." \ .text "Confirm that you want to abort current operation." \ .control_button.ok.text "Abort" \ .control_button.cancel.text "Resume" \ ]; ::if {$rwb1_debug} {::puts "rwb1_debug,operation_abort_query,1000.5";} ::if {!$Result} { ::set Duration [::expr {[::clock seconds]-$ClockSeconds}]; ::foreach OperationId $OperationIdList { ::sargs::var::set _data($OperationId) .start_seconds [::expr {[::sargs::integer_get $_data($OperationId) .start_seconds]+$Duration}]; /* { # 2.31.2 In nv2.31.2 testing, martin got empty method call bug on call to background_tick. I believe this happened when the operation was aborted. In any case changed the callback to be wrapped in subst and added check for object existence. This should be come routine on callbacks. Note: we can use "$this" instead of "[::itcl::code $this]" because $this is fully scoped in this particular case - ::qw::progress_blue_window. */ } ::sargs::var::set _data($OperationId) .tick_handle [::after 1000 [::subst -nocommands { ::if {[::qw::command_exists $this]} { $this background_tick .operation_id $OperationId; } }]]; # 2.23.2 #::sargs::var::set _data($OperationId) .tick_handle [::after 1000 [::itcl::code $this background_tick .operation_id $OperationId]]; } } ::if {$rwb1_debug} {::puts "rwb1_debug,operation_abort_query,1000.6";} ::return $Result; } method operation_abort {sargs} { ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,operation_abort,1000.0";} ::if {![::sargs::boolean_get $sargs .abort_query_skip]} { ::if {![operation_abort_query]} { ::if {$rwb1_debug} {::puts "rwb1_debug,operation_abort,1000.1";} ::return; } } #2.28.0 ::if {$rwb1_debug} {::puts "rwb1_debug,operation_abort,1000.2";} /* { ::if {![row_exists $sargs]} { ::if {$rwb1_debug} {::puts "rwb1_debug,operation_abort,1000.3";} ::return; } */ } ::if {$rwb1_debug} {::puts "rwb1_debug,operation_abort,1000.4";} ::set WorkingOperationIdList [operations_select .field .state .value "working"]; ::foreach OperationId $WorkingOperationIdList { ::if {$rwb1_debug} {::puts "rwb1_debug,operation_abort,1000.5";} $_table cellconfigure $OperationId,.state -text "aborted"; ::sargs::var::set _data($OperationId) .state "aborted"; ::if {$rwb1_debug} {::puts "rwb1_debug,operation_abort,1000.6";} ::if {[::sargs::get $_data($OperationId) .tick_handle] ne ""} { ::after cancel [::sargs::get $_data($OperationId) .tick_handle]; tick $sargs; ::if {$rwb1_debug} {::puts "rwb1_debug,operation_abort,1000.8";} } } ::if {$rwb1_debug} {::puts "rwb1_debug,operation_abort,1000.9";} status_set .status "Operation aborted."; ::if {$rwb1_debug} {::puts "rwb1_debug,operation_abort,1000.10";} ::return; ::qw::throw \ .text "Aborted by user." \ .priority ignore \ ; } method percent_calculate {Done Limit} { ::if {$Limit<=0.0} { ::return 0; } ::if {$Done>=$Limit} { ::return 100; } return [::expr int((1.0*$Done)/$Limit*100.0)]; } method status_refresh {} { ::set Status [::lindex $_status_stack end]; $itk_interior.status configure -text "[::string range $Status 0 128]"; } method minsize_set {} { ::set Width [::winfo reqwidth $_toplevel] ::set Height [::winfo reqheight $_toplevel] ::wm minsize $_toplevel $Width $Height } method row_exists {sargs} { ::set OperationId [::sargs::get $sargs .operation_id]; ::qw::try { $_table rowcget $OperationId -name; } catch Exception { ::return 0; } ::return 1; /* { What follows is a linear search, but I will assume that the code above is faster so used it instead. */ } /* { ::set Size [$_table size]; ::for {::set Row 0} {$Row<$Size} {::incr Row} { ::if {$OperationId eq [$_table rowcget $Row -name]} { ::return 1; } } ::return 0; */ } } method field_exists {sargs} { ::set Field [::sargs::get $sargs .field]; ::qw::try { $_table columncget $Field -name; } catch Exception { ::return 0; } ::return 1; /* { What follows is a linear search, but I will assume that the code above is faster so used it instead. */ } /* { ::set Size [$_table columncount]; ::for {::set Col 0} {$Col<$Size} {::incr Col} { ::if {$Field eq [$_table columncget $Col -name]} { ::return 1; } } ::return 0; */ } } method operation_configure {sargs} { /* { Note that we update some fields here because they aren't configured very often anyway. But the exception count and done count, if configured here are not configured in the tablelist cells. They are instead only updated to the cell once per second. */ } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,operation_configure,1000.0";} ::if {![row_exists $sargs]} { ::return; } ::set OperationId [::sargs::get $sargs .operation_id]; ::if {$rwb1_debug} {::puts "rwb1_debug,operation_configure,1000.1";} ::foreach {Field After} $sargs { ::if {$rwb1_debug} {::puts "rwb1_debug,operation_configure,1000.2";} ::set Before [::sargs::get $_data($OperationId) $Field]; ::set After [::sargs::get $sargs $Field]; ::if {$Before eq $After} { ::continue; } ::switch -- $Field { .status { status_set $sargs; } .description { ::set After [::sargs::get $sargs $Field]; ::sargs::var::set _data($OperationId) $Field $After; $_table cellconfigure $OperationId,$Field -text $After; } .state { ::if {$rwb1_debug} {::puts "rwb1_debug,operation_configure,state,2000.0,sargs==$sargs";} ::set After [::sargs::get $sargs $Field]; ::sargs::var::set _data($OperationId) $Field $After; ::if {$rwb1_debug} {::puts "rwb1_debug,operation_configure,state,2000.1";} ::if {$After ne "working"} { ::if {$rwb1_debug} {::puts "rwb1_debug,operation_configure,state,2000.2";} ::if {$rwb1_debug} {::puts "rwb1_debug,operation_configure,state,2000.3";} ::if {[::sargs::get $_data($OperationId) .tick_handle] ne ""} { /* { We cancel the last scheduled callback but we have to also update the count or else it will hang forever near but not quite completed. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,operation_configure,state,2000.4";} ::after cancel [::sargs::get $_data($OperationId) .tick_handle]; ::if {$rwb1_debug} {::puts "rwb1_debug,operation_configure,state,2000.5";} ::set CountVariableName [::sargs::get $_data($OperationId) .count_variable]; ::if {[::info exists $CountVariableName]} { #2.28.0 ::if {$rwb1_debug} {::puts "rwb1_debug,operation_configure,state,2000.6";} tick $sargs; ::if {$rwb1_debug} {::puts "rwb1_debug,operation_configure,state,2000.8";} } else { ::if {$rwb1_debug} {::puts "rwb1_debug,operation_configure,state,2000.9";} } } } ::if {$rwb1_debug} {::puts "rwb1_debug,operation_configure,state,2000.10,After==$After";} $_table cellconfigure $OperationId,$Field -text $After; ::if {$rwb1_debug} {::puts "rwb1_debug,operation_configure,state,2000.11";} } .done_count { # ::qw::bug 314120180720173211 "we don't configure .done_count anymore."; ::set CountVariableName [::sargs::get $_data($OperationId) .count_variable]; ::if {[::info exists $CountVariableName]} { ::set After [::set $CountVariableName]; ::set After [::qw::number::format_whole_number .value $After]; $_table cellconfigure $OperationId,$Field -text $After; } tick $sargs; } .limit { ::set After [::sargs::integer_get $sargs $Field]; ::sargs::var::set _data($OperationId) $Field $After; ::set After [::qw::number::format_whole_number .value $After]; $_table cellconfigure $OperationId,$Field -text $After; } .exception_count { ::set After [::sargs::integer_get $sargs $Field]; ::sargs::var::set _data($OperationId) $Field $After; $_table cellconfigure $OperationId,$Field -text $After; } .fixed_count { ::set After [::sargs::integer_get $sargs $Field]; ::sargs::var::set _data($OperationId) $Field $After; $_table cellconfigure $OperationId,$Field -text $After; } .count_variable { # ::qw::bug 314120180720171507 ".count_variable no longer used."; ::if {$After eq ""} { /* { Configuring with an empty text_variable turns off the callback if already set up. */ } ::set Handle [::sargs::get $_data($OperationId) .tick_handle]; ::if {$Handle ne ""} { ::after cancel $Handle; ::sargs::var::unset _data($OperationId) .tick_handle; ::sargs::var::unset _data($OperationId) .count_variable; } ::continue; } ::sargs::var::set _data($OperationId) $Field $After; ::if {[::sargs::get $_data($OperationId) .tick_handle] eq ""} { # 2.31.2 ::sargs::var::set _data($OperationId) .tick_handle [::after 1000 [::subst -nocommands { ::if {[::qw::command_exists $this]} { $this background_tick .operation_id $OperationId; } }]]; #2.31.2 ::sargs::var::set _data($OperationId) .tick_handle [::after 1000 [::itcl::code $this background_tick .operation_id $OperationId]]; } } .cb_abort_notify { ::sargs::var::set _data($OperationId) $Field $After; } .database_path { # 2.34.7 - some database paths were not being displayed ::sargs::var::set _data($OperationId) $Field $After; } default { ::continue; ::qw::throw "[::qw::methodname] - invalid field \"$Field\"."; } } ::if {$rwb1_debug} {::puts "rwb1_debug,operation_configure,1000.3";} } /* { 2.33.0 The update here forces most changes to the screen immediately. Unlike increment, these changes, such as updated fixes or errors, are releatively rare. */ } ::update; ::if {$rwb1_debug} {::puts "rwb1_debug,operation_configure,1000.99";} } method background_tick {sargs} { ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,background_tick,1000.0";} ::set OperationId [::sargs::get $sargs .operation_id]; ::if {$rwb1_debug} {::puts "rwb1_debug,background_tick,1000.1";} ::if {$OperationId eq ""} { ::qw::bug 314120140926132152 "[::qw::methodname] - no .operation_id argument."; } ::if {[::sargs::get $_data($OperationId) .state] ne "working"} { # 2.34.0 /* { This disables the ticking altogether because it doesn't schedule another tick. */ } ::return; } ::set CountVariableName [::sargs::get $_data($OperationId) .count_variable]; ::if {$rwb1_debug} {::puts "rwb1_debug,background_tick,1000.2";} #2.28.0 ::if {![::info exists $CountVariableName]} { ::return; } ::if {$rwb1_debug} {::puts "rwb1_debug,background_tick,1000.4";} tick $sargs; /* { 2.33.0 Somehow the window object is destroyed during the tick call. Our method continues to execute but $this is set to empty. So when we re-scheduled the call to background_tick, the $this became empty and the subst resulted in no argument being supplied for the ::qw::command_exists call in the scheduled after script. As a result bug 314120031208114611 occurred. Fix the whole thisng by testing $this before re-scheduling the after script. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,background_tick,1000.5";} ::if {[::qw::command_exists $this]} { ::sargs::var::set _data($OperationId) .tick_handle [::after 1000 [::subst -nocommands { # 2.31.2 ::if {[::qw::command_exists $this]} { $this background_tick .operation_id $OperationId; } }]]; } #2.31.2 ::sargs::var::set _data($OperationId) .tick_handle [::after 1000 [::itcl::code $this background_tick .operation_id $OperationId]]; ::if {$rwb1_debug} {::puts "rwb1_debug,background_tick,1000.6";} } method status_set {sargs} { ::if {[::sargs::exists $sargs .status]} { ::set Before [$_toplevel.status cget -text]; ::set After [::sargs::get $sargs .status]; ::if {$Before ne $After} { $_toplevel.status configure -text $After; } } } method operation_cget {sargs} { ::set OperationId [::sargs::get $sargs .operation_id]; ::if {$OperationId eq ""} { ::qw::bug 314120090619114947 "Encountered empty \".operation_id\"."; } ::set Field [::sargs::get $sargs .field]; ::if {$Field eq ""} { ::qw::bug 314120090619114948 "Encountered empty \".field\"."; } ::if {[find_row $sargs]<0} { ::return ""; } ::if {[find_col $sargs]<0} { ::return ""; } ::set After [::sargs::get $_data($OperationId) $Field]; ::return $After; } method operation_create {sargs} { /* { ::set DatabaseId [::sargs::get $sargs .database_id]; ::if {$DatabaseId eq ""} { ::qw::bug 314120050703092904 "Expected database id to be specified in operation progress."; } */ } /* { We create each operation so that it can be uniquely identified. We use a unique id as generated on the server/workstation but these can still conflict on a workstation when progress rows are a mixture of rows generated by both the workstation and server as in the fill column script. So we also use the computer's nic, after stripping the hyphens. But even this is not good enough when the server and workstation are on the same computer. So we also use the process id. That should do it. */ } ::if {[::sargs::integer_get $sargs .limit]<[::sargs::integer_get $sargs .minimum]} { # ::return [::sargs::set $sargs .operation_id ""]; ::return ""; } ::set Default [::sargs \ .state working \ .status "Performing operation, please wait or close window to abort." \ ]; ::set sargs [::sargs::+= $Default $sargs]; ::sargs::var::set sargs .progress_window $this; ::set Nic [::qw::remove_hyphens [[::qw::system] cpp_nic_get]]; /* { 2.28.0 Unlike the red progress we do not need the database_id and we also don't use it as part of the operation id. ::set OperationId ".${DatabaseId}_${Nic}_[::pid]_$_unique_id"; */ } ::set OperationId ".${Nic}_[::pid]_$_unique_id"; ::incr _unique_id 1; # ::set OperationId "operation_prefix_${DatabaseId}_${Nic}_[::pid]_[unique_id]"; ::sargs::var::set sargs .operation_id $OperationId; # ::set OperationCount [::llength $_operation_id_list]; # ::lappend _operation_id_list $OperationId; ::sargs::var::set sargs .start_seconds [::clock seconds]; ::set _data($OperationId) $sargs; $_toplevel.status configure -text [::sargs::get $sargs .status]; ::set Row [$_table size]; $_table insert end [::list]; $_table rowconfigure $Row -name $OperationId; ::set Size [$_table columncount]; ::for {::set Col 0} {$Col<$Size} {::incr Col} { ::set Field [$_table columncget $Col -name]; ::set Value [::sargs::get $sargs $Field]; ::if {[field_exists .field $Field]} { ::if {$Field eq ".limit"} { ::set Value [::qw::number::format_whole_number .value $Value]; } $_table cellconfigure $OperationId,$Field -text $Value; $_table cellconfigure $OperationId,$Field \ -foreground black \ -background white \ -selectforeground white \ ; } } ::if {[::sargs::exists $sargs .count_variable]} { # 2.31.2 ::sargs::var::set _data($OperationId) .tick_handle [::after 1000 [::subst -nocommands { ::if {[::qw::command_exists $this]} { $this background_tick .operation_id $OperationId; } }]]; # 2.31.2 ::sargs::var::set _data($OperationId) .tick_handle [::after 1000 [::itcl::code $this background_tick .operation_id $OperationId]]; } ::if {[field_exists .field .percent_done_graph]} { $_table cellconfigure $OperationId,.percent_done_graph \ -window [::itcl::code $this create_percent_done_graph_window] \ -stretchwindow 1 \ ; } $_table see $OperationId; ::raise $_toplevel; ::return $OperationId; } method create_percent_done_graph_window {Table Row Col Widget} { ::QW::WIDGET::COMPLETION_PERCENTAGE1 $Widget .foreground white /incomplete.background blue; # ::place $Widget -relheight 1.0; # ::place $Widget -relwidth 1.0; $Widget height_set 15; $Widget width_set 200; ::set OperationId [$_table rowcget $Row -name]; ::sargs::var::set _data($OperationId) .widget $Widget; # $_table window configure $Row,$ButtonCol -window $_table.$Row -sticky nesw; } /* { proc createFrame {tbl row col w} { # # Create the frame and replace the binding tag "Frame" # with "TablelistBody" in the list of its binding tags # frame $w -width 102 -height 14 -background ivory -borderwidth 1 \ -relief solid bindtags $w [lreplace [bindtags $w] 1 1 TablelistBody] # # Create the child frame and replace the binding tag "Frame" # with "TablelistBody" in the list of its binding tags # set fileSize [$tbl cellcget $row,fileSize -text] set width [expr {$fileSize * 100 / $::maxFileSize}] frame $w.f -width $width -background red -borderwidth 1 -relief raised bindtags $w.f [lreplace [bindtags $w] 1 1 TablelistBody] place $w.f -relheight 1.0 } */ } method operation_increment {sargs} { ::set OperationId [::sargs::get $sargs .operation_id]; ::if {![::info exists _data($OperationId)]} { #::qw::bug 314120180720070129 "no operation id"; ::return; } /* { ::if {![row_exists $sargs]} { ::return; } */ } ::set Increment [::sargs::get $sargs .increment]; ::if {$Increment eq ""} { #::qw::bug 314120180720070130 "no increment"; ::set Increment 1; } ::set CountVariableName [::sargs::get $_data($OperationId) .count_variable]; ::if {[::info exists $CountVariableName]} { ::incr $CountVariableName $Increment; tick $sargs; } else { } ::update; } method tick {sargs} { /* { Takes an .operation_id argument and causes it to update if a second has passed since th last update. */ } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,tick,1000.0,seconds==[::clock seconds]";} ::set OperationId [::sargs::get $sargs .operation_id]; ::if {![::info exists _data($OperationId)]} { ::if {$rwb1_debug} {::puts "rwb1_debug,tick,1000.1";} ::return; } ::if {$rwb1_debug} {::puts "rwb1_debug,tick,1000.2";} ::set LastClockSeconds [::sargs::get $_data($OperationId) .clock_seconds]; ::set ClockSeconds [::clock seconds]; ::set CountVariableName [::sargs::get $_data($OperationId) .count_variable]; ::if {[::info exists $CountVariableName]} { ::set DoneCount [::set $CountVariableName]; } else { ::set DoneCount 0; } ::set Limit [::sargs::integer_get $_data($OperationId) .limit]; ::if {$rwb1_debug} {::puts "rwb1_debug,tick,1000.3";} ::if {$ClockSeconds ne $LastClockSeconds||$DoneCount>=$Limit} { /* { We only update the information once per second. Otherwise a significant amount of time is taken up by the progress bar. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,tick,1000.4";} ::sargs::var::set _data($OperationId) .clock_seconds $ClockSeconds; ::set ClockStart [::sargs::get $_data($OperationId) .start_seconds]; ::set SecondsAfter [::expr {$ClockSeconds-$ClockStart}]; ::sargs::var::set _data($OperationId) .second_count $SecondsAfter; ::if {$rwb1_debug} {::puts "rwb1_debug,tick,1000.5";} $_table cellconfigure $OperationId,.second_count -text [::qw::clockutil::runtime_format_hms .seconds $SecondsAfter]; $_table cellconfigure $OperationId,.done_count -text [::qw::number::format_whole_number .value $DoneCount]; $_table cellconfigure $OperationId,.exception_count -text [::sargs::integer_get $_data($OperationId) .exception_count]; $_table cellconfigure $OperationId,.fixed_count -text [::sargs::integer_get $_data($OperationId) .fixed_count]; ::if {$rwb1_debug} {::puts "rwb1_debug,tick,1000.6";} ::set PercentBefore [::sargs::integer_get $_data($OperationId) .percent]; ::set PercentAfter [percent_calculate $DoneCount $Limit]; ::if {$rwb1_debug} {::puts "rwb1_debug,tick,1000.7";} ::if {$PercentBefore!=$PercentAfter} { ::set Widget [::sargs::get $_data($OperationId) .widget]; ::if {[::winfo exists $Widget]} { ::if {$rwb1_debug} {::puts "rwb1_debug,tick,1000.8";} $Widget percent $PercentAfter; ::if {$rwb1_debug} {::puts "rwb1_debug,tick,1000.9";} } ::sargs::var::set _data($OperationId) .percent $PercentAfter; } ::if {$rwb1_debug} {::puts "rwb1_debug,tick,1000.10";} ::sargs::var::set _data($OperationId) .clock_seconds [::clock seconds]; ::if {$rwb1_debug} {::puts "rwb1_debug,tick,1000.11";} ::update; ::if {$rwb1_debug} {::puts "rwb1_debug,tick,1000.12";} ::return; } ::if {$rwb1_debug} {::puts "rwb1_debug,tick,1000.13";} } method operation_destroy {sargs} { ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,operation_destroy,1000.0,sargs==$sargs";} ::set OperationId [::sargs::get $sargs .operation_id]; ::if {![::info exists _data($OperationId)]} { ::if {$rwb1_debug} {::puts "rwb1_debug,operation_destroy,1000.1";} ::return; } ::if {![row_exists $sargs]} { ::if {$rwb1_debug} {::puts "rwb1_debug,operation_destroy,1000.2";} ::return; } ::if {[::sargs::get $_data($OperationId) .tick_handle] ne ""} { ::if {$rwb1_debug} {::puts "rwb1_debug,operation_destroy,1000.3";} ::after cancel [::sargs::get $_data($OperationId) .tick_handle]; } ::if {$rwb1_debug} {::puts "rwb1_debug,operation_destroy,1000.4";} ::unset -nocomplain [::sargs::get $_data($OperationId) .count_variable]; ::unset _data($OperationId); ::if {$rwb1_debug} {::puts "rwb1_debug,operation_destroy,1000.5";} $_table delete $OperationId; ::if {$rwb1_debug} {::puts "rwb1_debug,operation_destroy,1000.6";} $_table see end; ::if {$rwb1_debug} {::puts "rwb1_debug,operation_destroy,1000.7";} ::raise $_toplevel; ::if {$rwb1_debug} {::puts "rwb1_debug,operation_destroy,1000.8";} ::if {[$_table size]>0} { ::if {$rwb1_debug} {::puts "rwb1_debug,operation_destroy,1000.9";} ::set EndOperationId [$_table rowcget end -name]; $_toplevel.status configure -text [::sargs::get $_data($EndOperationId) .status]; ::if {$rwb1_debug} {::puts "rwb1_debug,operation_destroy,1000.10";} } ::if {$rwb1_debug} {::puts "rwb1_debug,operation_destroy,1000.11";} } method operation_is_aborted {sargs} { /* { operation_is_aborted .operation_id Id; */ } ::set OperationId [::sargs::get $sargs .operation_id]; ::if {![::info exists _data($OperationId)]} { ::return 1; } ::if {[::sargs::get $_data($OperationId) .state] eq "aborted"} { ::return 1; } # ::if {[$_table cellcget $OperationId,.state -text] eq "aborted"} { # ::return 1; # } ::return 0; } method operations_select {sargs} { /* { Returns the list of operations that are working. Really this is just used to test for abort by an external program (such as nvcheck) that has no access to operation_ids. */ } ::set Field [::sargs::get $sargs .field]; ::set Value [::sargs::get $sargs .value]; ::if {$Field eq ""} { ::qw::bug 314120091023130845 "Encountered empty \".field\" argument."; } ::set OperationIdList [::list]; ::set Size [$_table size]; ::for {::set Row 0} {$Row<$Size} {::incr Row} { ::set OperationId [$_table rowcget $Row -name]; ::if {[::sargs::get $_data($OperationId) $Field] eq $Value} { ::lappend OperationIdList $OperationId; } } ::return $OperationIdList; } method dialog_help_page {sargs} { ::return { .title "Progress Window" .id 314220091030142704 .tags {tag_manual tag_user} .body { [h1 "Progress Window"] [p { This window is used by long-running NewViews operations to display their progress. Also, you can often abort an operation by clicking the abort button in the tool bar. You are always asked for confirmation before the abort is actually performed and you are always given the option of resuming the operation. }] [h2 "Progress Window Columns"] [ul { [li { [p { [bold "Description"] - Very brief description of the operation. }] }] [li { [p { [bold "File"] - The database file (if any) on which operation was performed. }] }] [li { [p { [bold "State"] - Either [qw_quoted working] or how operation completed. }] [p { The state generally contains any of the following values: }] [ul { [li { [p { [bold working] - The operation is in progress. }] [p { The [qw_field_name Count] field should be increasing and the progress bar should also be increasing as the operation is currently active and being performed. }] }] [li { [p { [bold succeeded] - The operation completed successfully. }] [p { The operation finished and no problems occurred. }] }] [li { [p { [bold completed] - The operation finished, but problems were detected. }] [p { For example, suppose an operation was performed to check the integrity of a database. If the operation was allowed to finish but integrity problems were detected, then [qw_field_value completed] will be reported in the [qw_field_name State] column. state. If the operation finished and no problems were detected then [qw_field_value succeeded] will be reported in the [qw_field_name State] column. }] [p { The [qw_field_name Done] and [qw_field_name "Percent Complete"] fields give you a good idea of how far the operation proceeded before it ended. }] }] [li { [p { [bold failed] - The operation was terminated due to an error. }] [p { An unexpected error occurred during the operation. Sometimes failed may be reported on purpose. For example, normally a check operation might complele even when problems are reported. In this case the [qw_field_name State] would be set to [qw_field_value completed]. However, the check might self-abort if [qw_quoted "too many"] problems are detected and in this case [qw_field_name State] is set to [qw_field_value failed]. }] [p { The [qw_field_name Done] and [qw_field_name "Percent Complete"] fields give you a good idea of how far the operation proceeded before it ended. }] }] }] }] [li { [p { [bold "Run Time"] - Total time operation has been running. }] [p { This tells you in hh:mm:ss (hours:minutes:seconds) how long the operation has been running or if finished, how long it took. }] [p { The time is in real world clock time, not cpu time. For example, the same operation will generally take longer if other programs are running concurrently. }] }] [li { [p { [bold "Errors"] - Number of errors/exceptions/problems detected by the operation. }] [p { Some operations may detect and report errors. Database integrity checking operations report progress and do want to report error detection as they do so. This field reports the error count. Often you may want to abort the operation if errors have occurred, rather than waiting for a potentially very long-running operation to complete. }] }] [li { [p { [bold "Count"] - This number of steps must be performed. }] [p { Each operation estimates the number of steps it must perform an displays it in the [qw_field_name Count] column. }] }] [li { [p { [bold "Done"] - This number of steps has been perfomed. }] [p { The operation has already performed this number of steps. When [qw_field_name Done] reaches [qw_field Count], the operation is 100% done. }] }] [li { [p { [bold "Percent Done"] - The percent of the steps has been performed. }] [p { When the progress bar reaches 100% it turns green. }] }] }] } } } } variable ::qw::progress_blue::_count 0; ::proc ::qw::progress_blue::window_create_on_demand {sargs} { ::if {![::qw::command_exists ::qw::progress_blue_window]} { ::qw::dialog85::progress_blue ::qw::progress_blue_window; ::qw::progress_blue_window main $sargs; } ::return ::qw::progress_blue_window; } ::proc ::qw::progress_blue::window_destroy {sargs} { ::if {[::qw::command_exists ::qw::progress_blue_window]} { ::itcl::delete object ::qw::progress_blue_window; } } ::proc ::qw::progress_blue::operation_create {sargs} { ::qw::progress_blue::window_create_on_demand \ .window_title "Operation progress ..." \ ; ::set Result [::qw::progress_blue_window operation_create $sargs]; ::return $Result; } ::proc ::qw::progress_blue::operation_destroy {sargs} { ::if {[::qw::command_exists ::qw::progress_blue_window]} { ::qw::progress_blue_window operation_destroy $sargs; } } ::proc ::qw::progress_blue::operation_increment {sargs} { operation_abort_check $sargs; ::if {[::qw::progress_blue::operation_is_aborted $sargs]} { ::return; } ::if {[::sargs::get $sargs .increment] eq ""} { ::sargs::var::set sargs .increment 1; } ::qw::progress_blue_window operation_increment $sargs; } ::proc ::qw::progress_blue::operation_configure {sargs} { #2.34.0 removed the abort_check because we want to set the state without throwing # operation_abort_check $sargs; ::if {[::qw::command_exists ::qw::progress_blue_window]} { ::qw::progress_blue_window operation_configure $sargs; } } ::proc ::qw::progress_blue::window_configure {sargs} { operation_abort_check $sargs; ::if {[::qw::command_exists ::qw::progress_blue_window]} { ::qw::progress_blue_window window_configure $sargs; } } ::proc ::qw::progress_blue::status_set {sargs} { operation_abort_check $sargs; ::if {[::qw::command_exists ::qw::progress_blue_window]} { ::qw::progress_blue_window status_set $sargs; } } ::proc ::qw::progress_blue::configure {sargs} { operation_abort_check $sargs; ::if {[::qw::command_exists ::qw::progress_blue_window]} { ::qw::progress_blue_window configure $sargs; } } ::proc ::qw::progress_blue::is_aborted {sargs} { ::if {![::qw::command_exists ::qw::progress_blue_window]} { ::return 1; } ::if {[::llength [::qw::progress_blue_window operations_select .field .state .value "working"]]==0} { ::return 1; } ::return 0; } ::proc ::qw::progress_blue::operations_select {sargs} { ::if {[::qw::command_exists ::qw::progress_blue_window]} { ::return [::qw::operations_select $sargs]; } ::return ""; } ::proc ::qw::progress_blue::operation_is_aborted {sargs} { /* { operation_is_aborted .operation_id $OperationId; Check whether a particular operation is aborted. */ } ::if {![::qw::command_exists ::qw::progress_blue_window]} { ::return 1; } ::set Result [::qw::progress_blue_window operation_is_aborted $sargs]; ::return $Result; } ::proc ::qw::progress_blue::operation_abort_check {sargs} { ::if {[::qw::progress_blue::operation_is_aborted $sargs]} { ::qw::throw \ .exception_id aborted \ .priority ignore \ .text "Operation aborted by user." \ ; } } ::proc ::qw::progress_blue::operations_select {sargs} { /* { returns the list of operations that are working. Really this is just used to test for abort by an external program (such as nvcheck) that has no access to operation_ids. */ } ::if {![::qw::command_exists ::qw::progress_blue_window]} { ::return ""; } ::return [::qw::progress_blue_window operations_select $sargs]; } ::proc ::qw::progress_blue::operation_tick {sargs} { /* { 2.28.4 */ } ::if {![::qw::command_exists ::qw::progress_blue_window]} { ::return ""; } ::return [::qw::progress_blue_window tick $sargs]; } ::proc ::qw::progress_blue::count_variable_generate {} { # 2.32.3 - database_utilities_paf /* { Creates a unique count variable (in the ::qw::progress_blue namespace) and initializes it to 0. */ } ::set Count 0; ::while {[::info exists ::qw::progress_blue::count_variable_$Count]} { ::incr Count 1; } ::set ::qw::progress_blue::count_variable_$Count 0; ::return ::qw::progress_blue::count_variable_$Count; }