git-gui: Ensure error dialogs always appear over all other windows
[git] / lib / error.tcl
1 # git-gui branch (create/delete) support
2 # Copyright (C) 2006, 2007 Shawn Pearce
3
4 proc _error_parent {} {
5         return [grab current .]
6 }
7
8 proc error_popup {msg} {
9         set title [appname]
10         if {[reponame] ne {}} {
11                 append title " ([reponame])"
12         }
13         set cmd [list tk_messageBox \
14                 -icon error \
15                 -type ok \
16                 -title [append "$title: " [mc "error"]] \
17                 -message $msg]
18         if {[winfo ismapped [_error_parent]]} {
19                 lappend cmd -parent [_error_parent]
20         }
21         eval $cmd
22 }
23
24 proc warn_popup {msg} {
25         set title [appname]
26         if {[reponame] ne {}} {
27                 append title " ([reponame])"
28         }
29         set cmd [list tk_messageBox \
30                 -icon warning \
31                 -type ok \
32                 -title [append "$title: " [mc "warning"]] \
33                 -message $msg]
34         if {[winfo ismapped [_error_parent]]} {
35                 lappend cmd -parent [_error_parent]
36         }
37         eval $cmd
38 }
39
40 proc info_popup {msg} {
41         set title [appname]
42         if {[reponame] ne {}} {
43                 append title " ([reponame])"
44         }
45         tk_messageBox \
46                 -parent $parent \
47                 -icon info \
48                 -type ok \
49                 -title $title \
50                 -message $msg
51 }
52
53 proc ask_popup {msg} {
54         set title [appname]
55         if {[reponame] ne {}} {
56                 append title " ([reponame])"
57         }
58         set cmd [list tk_messageBox \
59                 -icon question \
60                 -type yesno \
61                 -title $title \
62                 -message $msg]
63         if {[winfo ismapped [_error_parent]]} {
64                 lappend cmd -parent [_error_parent]
65         }
66         eval $cmd
67 }
68
69 proc hook_failed_popup {hook msg {is_fatal 1}} {
70         set w .hookfail
71         toplevel $w
72
73         frame $w.m
74         label $w.m.l1 -text "$hook hook failed:" \
75                 -anchor w \
76                 -justify left \
77                 -font font_uibold
78         text $w.m.t \
79                 -background white -borderwidth 1 \
80                 -relief sunken \
81                 -width 80 -height 10 \
82                 -font font_diff \
83                 -yscrollcommand [list $w.m.sby set]
84         scrollbar $w.m.sby -command [list $w.m.t yview]
85         pack $w.m.l1 -side top -fill x
86         if {$is_fatal} {
87                 label $w.m.l2 \
88                         -text [mc "You must correct the above errors before committing."] \
89                         -anchor w \
90                         -justify left \
91                         -font font_uibold
92                 pack $w.m.l2 -side bottom -fill x
93         }
94         pack $w.m.sby -side right -fill y
95         pack $w.m.t -side left -fill both -expand 1
96         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
97
98         $w.m.t insert 1.0 $msg
99         $w.m.t conf -state disabled
100
101         button $w.ok -text OK \
102                 -width 15 \
103                 -command "destroy $w"
104         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
105
106         bind $w <Visibility> "grab $w; focus $w"
107         bind $w <Key-Return> "destroy $w"
108         wm title $w [strcat "[appname] ([reponame]): " [mc "error"]]
109         tkwait window $w
110 }