Blocked GUI activities until yes/no window resp. error window are closed

This commit is contained in:
Thomas Schmitt 2013-01-03 12:56:21 +00:00
parent 060f8b1bef
commit fbae233bd8
2 changed files with 107 additions and 8 deletions

View File

@ -2664,7 +2664,6 @@ proc set_display_msg {mode} {
# Display a frontend error message in the .msglist box and by a pop-up window.
# >>> It would be nice to be able to wait for user confirmation.
#
proc xorriso_tcltk_errmsg {msg} {
global highest_cmd_sev_msg
@ -2716,6 +2715,7 @@ proc destroy_yesno {w answer} {
if {$w != ""} {
set yesno_window_geometry [wm geometry $w]
grab release $w
destroy $w
}
set yesno_window_is_active 0
@ -2737,6 +2737,9 @@ proc window_yesno {question} {
global answer_of_yesno yesno_window_is_active yesno_window_geometry
set w {.yesno_window}
if {"$yesno_window_is_active" == 1} {
set yesno_window_is_active [window_exists $w]
}
if {"$yesno_window_is_active" == 1} {
raise $w
xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : You still need to answer an older yes/no question"
@ -2750,11 +2753,14 @@ proc window_yesno {question} {
label $w.question -text "$question"
button $w.yes -text "yes" -command "destroy_yesno $w 1" \
-borderwidth 4 -padx 20 -pady 20
bind_help $w.yes "yes/no"
button $w.no -text "no" -command "destroy_yesno $w 0" \
-borderwidth 4 -padx 20 -pady 20
bind_help $w.no "yes/no"
pack $w.yes $w.question $w.no -side left
update idletasks
grab set $w
tkwait variable answer_of_yesno
return "$answer_of_yesno"
}
@ -2768,6 +2774,9 @@ proc window_yesno_ever {question} {
global yesno_to_all
set w {.yesno_window}
if {"$yesno_window_is_active" == 1} {
set yesno_window_is_active [window_exists $w]
}
if {"$yesno_window_is_active" == 1} {
raise $w
xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : You still need to answer an older yes/no question"
@ -2802,6 +2811,7 @@ proc window_yesno_ever {question} {
-in $w -side left -expand 1 -fill both
update idletasks
grab set $w
tkwait variable answer_of_yesno
return "$answer_of_yesno"
}
@ -2816,11 +2826,13 @@ proc reset_yesno_to_all {} {
# Destroy the notification pop-up window.
#
proc destroy_ack {w} {
proc destroy_ack {w had_focus} {
global ack_window_is_active ack_window_geometry
if {"$w" != ""} {
set ack_window_geometry [wm geometry $w]
grab release $w
focus "$had_focus"
destroy "$w"
}
set ack_window_is_active 0
@ -2831,13 +2843,18 @@ proc destroy_ack {w} {
#
proc window_ack {question button_color where} {
global answer_of_yesno ack_window_is_active ack_window_geometry
global continue_from_ack
set had_focus [focus]
set re_use_widgets 0
if {"$where" == "embedded"} {
set w ""
set destroy_cmd ""
} else {
set w {.ack_window}
if {"$ack_window_is_active" == 1} {
set ack_window_is_active [window_exists $w]
}
if {"$ack_window_is_active" == 0} {
toplevel $w -borderwidth 20 -class Dialog
wm title $w "xorriso-tcltk acknowledge"
@ -2846,7 +2863,7 @@ proc window_ack {question button_color where} {
set re_use_widgets 1
}
set_window_position $w "$ack_window_geometry"
set destroy_cmd "destroy_ack $w"
set destroy_cmd "destroy_ack $w $had_focus"
}
if {"$re_use_widgets" == 1} {
$w.question configure -text "$question"
@ -2855,12 +2872,15 @@ proc window_ack {question button_color where} {
label $w.question -text "$question"
button $w.ok -text "Continue" -command "$destroy_cmd" \
-background "$button_color"
bind $w.ok <Return> "$destroy_cmd"
bind_help $w.ok "Continue"
pack $w.question -side top -expand 1 -fill both
pack $w.ok -side top
}
# >>> How to block any event but the "Continue" button ?
focus $w.ok
grab set $w
tkwait variable ack_window_is_active
}
@ -2917,6 +2937,9 @@ proc window_help {about_what button_color} {
set old_geometry "$help_window_geometry"
set window_lines "$help_window_lines"
}
if {"$window_is_active" == 1} {
set window_is_active [window_exists $w]
}
# Giving the help text some distance from the border decorations
set line_width 82
@ -2935,6 +2958,32 @@ proc window_help {about_what button_color} {
set old_geometry "$help_window_geometry"
}
}
# Dealing with initiating windows that are grabbed
set grabbed [grab current]
if {$grabbed == ""} {set grabbed "-"}
if {$grabbed != "-" && $window_is_active == 1} {
destroy_help $w "$help_main"
set window_is_active 0
}
if {$grabbed != "-"} {
# Set old_geometry to position underneath grabbed window
set value [wm geometry $grabbed]
set idx [string first "+" $value]
set height_idx [string first "x" $value]
if {$idx != -1 && $height_idx != -1 && $idx > $height_idx} {
set width [string range $value 0 [expr $height_idx-1]]
set height [string range $value [expr $height_idx+1] [expr $idx-1]]
set x [string range $value [expr $idx+1] end]
set idx [string first "+" $x]
if {"$idx" != -1} {
set y [string range $x [expr $idx+1] end]
set x [string range $x 0 [expr $idx-1]]
set y [expr $y+$height]
set old_geometry "${width}x${height}+${x}+${y}"
}
}
}
set re_use_widgets 0
if {"$window_is_active" == 0} {
toplevel $w -borderwidth "$help_window_border_width" -class Help
@ -2951,6 +3000,7 @@ proc window_help {about_what button_color} {
} else {
set re_use_widgets 1
}
if {"$re_use_widgets" == 1} {
$w.text configure -state normal
$w.text delete 1.0 end
@ -3054,6 +3104,18 @@ proc reset_to_normal_background {w} {
}
# Checks whether a window is really there
#
proc window_exists {w} {
set window_exists 0
catch {
$w cget -background
set window_exists 1
}
return $window_exists
}
# ------ Building GUI components ------
# ------ GUI layout parameters ------
@ -4718,7 +4780,9 @@ about to overwrite a file object and more such overwrite situations are
to be expected.
If the button is clicked, then all further yes/no questions of that GUI
action will be answered automatically with yes."
action will be answered automatically with yes.
[about_help_for_yesno]"
}
if {"$what" == "no to all"} {
return \
@ -4727,7 +4791,30 @@ about to overwrite a file object and more such overwrite situations are
to be expected.
If the button is clicked, then all further yes/no questions of that GUI
action will be answered automatically with no."
action will be answered automatically with no.
[about_help_for_yesno]"
}
if {"$what" == "Continue"} {
return \
"The \"Continue\" button appears in the notification windows which tell
about a failed or rejected GUI action.
---------------------------------------------------------------------------
It is impossible to trigger any further GUI action while the notification
window is displayed. You either have to click the \"Continue\" button
or hit the Return key.
You cannot even close this help window before you did that."
}
if {"$what" == "yes/no"} {
return \
"The \"yes\" and \"no\" buttons appear in the confirmation window which tells
about a potentially dangerous GUI action and demands a user decision whether
to really perform this action.
[about_help_for_yesno]"
}
return "--- No help text found for topic '$what'"
@ -4772,6 +4859,18 @@ the associated text field, but does not hit the Return key.
}
# Tell about pecliarity of help window triggered by yes/no window
proc about_help_for_yesno {} {
return \
"---------------------------------------------------------------------------
It is impossible to trigger any further GUI action while the confirmation
window is displayed. You have to click one of the buttons in that window.
You cannot even close this help window before you clicked one of the buttons."
}
# ------- Misc helper procedures -------

View File

@ -1 +1 @@
#define Xorriso_timestamP "2013.01.03.102627"
#define Xorriso_timestamP "2013.01.03.125535"