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