git-gui / lib / error.tclon commit Merge branch 'master' of git://git.kernel.org/pub/scm/gitk/gitk (071a887)
   1# git-gui branch (create/delete) support
   2# Copyright (C) 2006, 2007 Shawn Pearce
   3
   4proc 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
  20proc 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
  36proc 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
  49proc 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
  65proc 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 {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 "[appname] ([reponame]): error"
 103        tkwait window $w
 104}