# ------------------------------------------------------------ # ::QW::OPERATION class # ------------------------------------------------------------ /* { You display an ongoing operation as follows: ::itcl::local #auto .text "Display this text as the operation." This will append text for the operation to an operation window and remove the text automatically when the local goes out of scope. An operation window is created and destroyed on demand. */ } ::itcl::class ::QW::OPERATION_TOPLEVEL { /* { This class represents the toplevel containing the operation messages. */ } public common _window {} protected variable _toplevel {}; protected variable _options ""; protected variable _count 0; method option_get {Path} {::return [::sargs::get_poly $_options $Path];} method option_set {args} { ::qw::s_args_marshal; ::sargs::var::+= _options $s_args; } method constructor {args} { ::set _options $::qw::widget::options; ::sargs::var::+= _options [::subst { .title "[::string tolower [::info nameofexecutable]]" }]; ::sargs::var::+= _options $args; ::set _toplevel [::toplevel .qw_operation_window_[::qw::id_factory] -background [option_get .background]]; ::wm overrideredirect $_toplevel 1 # Next lines removed when overrideredirect was added. # ::wm title $_toplevel [option_get .title]; # ::wm protocol $_toplevel WM_DELETE_WINDOW [::list ::qw::itcl_delete_object $this]; ::wm deiconify $_toplevel; ::set Frame [::frame $_toplevel.frame]; $Frame configure -borderwidth 5 -background [option_get .background] -relief raised; ::pack $Frame; ::wm geometry $_toplevel +50+50; ::set ::QW::OPERATION_TOPLEVEL::_window $this; } destructor { # ::if {::winfo exists $_toplevel} {::destroy $_toplevel} ::destroy $_toplevel; ::set ::QW::OPERATION_TOPLEVEL::_window ""; } method toplevel {} {::return $_toplevel;} } ::set ::QW::OPERATION_TOPLEVEL::_window ""; # Just to be sure it exists. ::itcl::class ::QW::OPERATION { /* { This class represents an operation message. Its current implementation is to create a label and pack it into the operation toplevel level window. The label is destroyed when the operation is complete and this object is destroyed, usually using ::itcl::local. The toplevel itself is created if it doesn't exists and is destroyed if its last label is destroyed. */ } protected variable _toplevel ""; protected variable _label ""; protected variable _options ""; protected variable _grab_save ""; method option_get {Path} { ::return [::sargs::get_poly $_options $Path]; } method option_set {sargs} { ::sargs::var::+= _options $s_args; } method constructor {sargs} { ::if {[::sargs::boolean_get $sargs .progress.skip]} { ::return; } ::set _options $::qw::widget::options; ::sargs::var::+= _options [::subst { .title "[::string tolower [::info nameofexecutable]] is performing an operation ..." .font {-family Arial -size 10 -weight normal} .text "[::string tolower [::info nameofexecutable]] is performing an operation." .foreground black .background yellow3 .justify left }]; # was azure3 ::sargs::var::+= _options $sargs; ::if {$::QW::OPERATION_TOPLEVEL::_window eq ""} { ::set _toplevel [[::eval ::QW::OPERATION_TOPLEVEL #auto $_options] toplevel]; } else { ::set _toplevel [$::QW::OPERATION_TOPLEVEL::_window toplevel]; } ::if {[::sargs::exists $sargs .x]} { /* { 2.11.2 pgq wanted to position the operation window. */ } ::wm geometry $_toplevel +[::sargs::integer_get $sargs .x]+[::sargs::integer_get $sargs .y]; } ::set _label [::label $_toplevel.frame.[::qw::id_factory] \ -font [option_get .font] \ -foreground [option_get .foreground] \ -background [option_get .background] \ -justify [option_get .justify] \ -text [option_get .text] ]; ::pack $_label -anchor w -expand 1; /* { 2.26.0 The commented changes were an attempt to keep the yellow operation window on top, especially when installing (i.e. 2.26.0) where operation was added. But there were hurendous unitended side-effects so it had to be undone (by pgq). The insallation now just writes progress to a text window. The unintended side-effect: The simplest was take an existing workstation, pick any random explorer pane, in the tile bar of say a report, do a right-click default window setup. He would put up a confoirm dialog followed by an operation window and upon completion the focus could not be returned to NewViews no matter what. Had to activate another application and then switch back to newviews to regain the focus. */ } #pgq ::set _grab_save [::grab current $_toplevel]; #pgq ::grab set $_toplevel; #pgq ::qw::toplevel_add .toplevel $_toplevel; ::update; } destructor { destroy; } method destroy {} { ::if {[::winfo exists $_label]} { ::destroy $_label; ::set _label ""; #2.23.0 ::update; ::update idletasks; } ::if {[::winfo exists $_toplevel]} { #2.26.0 #pgq ::grab release $_toplevel; #pgq ::if {[::winfo exists $_grab_save]} { #pgq ::grab set $_grab_save; #pgq } #pgq ::qw::toplevel_remove .toplevel $_toplevel; #pgq ::if {[::llength [::pack slaves $_toplevel.frame]]==0} { #} ::if {![::llength [::pack slaves $_toplevel.frame]]} { #pgq ::itcl::delete object $::QW::OPERATION_TOPLEVEL::_window; ::set ::QW::OPERATION_TOPLEVEL::_window ""; #2.23.0 ::update; ::update idletasks; } } ::set _toplevel ""; } }