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_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        return [tk_messageBox \
  55                -parent . \
  56                -icon question \
  57                -type yesno \
  58                -title $title \
  59                -message $msg]
  60}
  61
  62proc 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}