git-commit-vandalism/lib/error.tcl
Shawn O. Pearce aba15f7f59 git-gui: Ensure error dialogs always appear over all other windows
If we are opening an error dialog we want it to appear above all of
the other windows, even those that we may have opened with a grab
to make the window modal.  Failure to do so may allow an error
dialog to open up (and grab focus!) under an existing toplevel,
making the user think git-gui has frozen up and is unresponsive,
as they cannot get to the dialog.

Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
2008-02-20 23:39:32 -05:00

111 lines
2.3 KiB
Tcl

# git-gui branch (create/delete) support
# Copyright (C) 2006, 2007 Shawn Pearce
proc _error_parent {} {
return [grab current .]
}
proc error_popup {msg} {
set title [appname]
if {[reponame] ne {}} {
append title " ([reponame])"
}
set cmd [list tk_messageBox \
-icon error \
-type ok \
-title [append "$title: " [mc "error"]] \
-message $msg]
if {[winfo ismapped [_error_parent]]} {
lappend cmd -parent [_error_parent]
}
eval $cmd
}
proc warn_popup {msg} {
set title [appname]
if {[reponame] ne {}} {
append title " ([reponame])"
}
set cmd [list tk_messageBox \
-icon warning \
-type ok \
-title [append "$title: " [mc "warning"]] \
-message $msg]
if {[winfo ismapped [_error_parent]]} {
lappend cmd -parent [_error_parent]
}
eval $cmd
}
proc info_popup {msg} {
set title [appname]
if {[reponame] ne {}} {
append title " ([reponame])"
}
tk_messageBox \
-parent $parent \
-icon info \
-type ok \
-title $title \
-message $msg
}
proc ask_popup {msg} {
set title [appname]
if {[reponame] ne {}} {
append title " ([reponame])"
}
set cmd [list tk_messageBox \
-icon question \
-type yesno \
-title $title \
-message $msg]
if {[winfo ismapped [_error_parent]]} {
lappend cmd -parent [_error_parent]
}
eval $cmd
}
proc hook_failed_popup {hook msg {is_fatal 1}} {
set w .hookfail
toplevel $w
frame $w.m
label $w.m.l1 -text "$hook hook failed:" \
-anchor w \
-justify left \
-font font_uibold
text $w.m.t \
-background white -borderwidth 1 \
-relief sunken \
-width 80 -height 10 \
-font font_diff \
-yscrollcommand [list $w.m.sby set]
scrollbar $w.m.sby -command [list $w.m.t yview]
pack $w.m.l1 -side top -fill x
if {$is_fatal} {
label $w.m.l2 \
-text [mc "You must correct the above errors before committing."] \
-anchor w \
-justify left \
-font font_uibold
pack $w.m.l2 -side bottom -fill x
}
pack $w.m.sby -side right -fill y
pack $w.m.t -side left -fill both -expand 1
pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
$w.m.t insert 1.0 $msg
$w.m.t conf -state disabled
button $w.ok -text OK \
-width 15 \
-command "destroy $w"
pack $w.ok -side bottom -anchor e -pady 10 -padx 10
bind $w <Visibility> "grab $w; focus $w"
bind $w <Key-Return> "destroy $w"
wm title $w [strcat "[appname] ([reponame]): " [mc "error"]]
tkwait window $w
}