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 }