git.oblomov.eu Git - git/blob - 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 [append "$title: " [mc "error"]] \
  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 [append "$title: " [mc "warning"]] \
  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 "$hook hook failed:" \
  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 [strcat "[appname] ([reponame]): " [mc "error"]]
 117         wm deiconify $w
 118         tkwait window $w
 119 }