git.oblomov.eu Git - git/blob - 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 [append "$title: " [mc "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 [append "$title: " [mc "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         set cmd [list tk_messageBox \
  55                 -icon question \
  56                 -type yesno \
  57                 -title $title \
  58                 -message $msg]
  59         if {[winfo ismapped .]} {
  60                 lappend cmd -parent .
  61         }
  62         eval $cmd
  63 }
  64
  65 proc hook_failed_popup {hook msg} {
  66         set w .hookfail
  67         toplevel $w
  68
  69         frame $w.m
  70         label $w.m.l1 -text "$hook hook failed:" \
  71                 -anchor w \
  72                 -justify left \
  73                 -font font_uibold
  74         text $w.m.t \
  75                 -background white -borderwidth 1 \
  76                 -relief sunken \
  77                 -width 80 -height 10 \
  78                 -font font_diff \
  79                 -yscrollcommand [list $w.m.sby set]
  80         label $w.m.l2 \
  81                 -text [mc "You must correct the above errors before committing."] \
  82                 -anchor w \
  83                 -justify left \
  84                 -font font_uibold
  85         scrollbar $w.m.sby -command [list $w.m.t yview]
  86         pack $w.m.l1 -side top -fill x
  87         pack $w.m.l2 -side bottom -fill x
  88         pack $w.m.sby -side right -fill y
  89         pack $w.m.t -side left -fill both -expand 1
  90         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
  91
  92         $w.m.t insert 1.0 $msg
  93         $w.m.t conf -state disabled
  94
  95         button $w.ok -text OK \
  96                 -width 15 \
  97                 -command "destroy $w"
  98         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
  99
 100         bind $w <Visibility> "grab $w; focus $w"
 101         bind $w <Key-Return> "destroy $w"
 102         wm title $w [append "[appname] ([reponame]): " [mc "error"]]
 103         tkwait window $w
 104 }