lib/error.tcl

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