Andrew's git - gitweb.git/blob - git-gui/lib/error.tcl

   1# git-gui branch (create/delete) support
   2# Copyright (C) 2006, 2007 Shawn Pearce
   3
   4proc _error_parent {} {
   5        set p [grab current .]
   6        if {$p eq {}} {
   7                return .
   8        }
   9        return $p
  10}
  11
  12proc 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
  28proc 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
  44proc 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
  57proc 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
  73proc 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}