lib/console.tcl

   1 # git-gui console support
   2 # Copyright (C) 2006, 2007 Shawn Pearce
   3
   4 namespace eval console {
   5
   6 variable next_console_id 0
   7 variable console_data
   8 variable console_cr
   9
  10 proc new {short_title long_title} {
  11         variable next_console_id
  12         variable console_data
  13
  14         set w .console[incr next_console_id]
  15         set console_data($w) [list $short_title $long_title]
  16         return [_init $w]
  17 }
  18
  19 proc _init {w} {
  20         global M1B
  21         variable console_cr
  22         variable console_data
  23
  24         set console_cr($w) 1.0
  25         toplevel $w
  26         frame $w.m
  27         label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
  28                 -anchor w \
  29                 -justify left \
  30                 -font font_uibold
  31         text $w.m.t \
  32                 -background white -borderwidth 1 \
  33                 -relief sunken \
  34                 -width 80 -height 10 \
  35                 -font font_diff \
  36                 -state disabled \
  37                 -yscrollcommand [list $w.m.sby set]
  38         label $w.m.s -text {Working... please wait...} \
  39                 -anchor w \
  40                 -justify left \
  41                 -font font_uibold
  42         scrollbar $w.m.sby -command [list $w.m.t yview]
  43         pack $w.m.l1 -side top -fill x
  44         pack $w.m.s -side bottom -fill x
  45         pack $w.m.sby -side right -fill y
  46         pack $w.m.t -side left -fill both -expand 1
  47         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
  48
  49         menu $w.ctxm -tearoff 0
  50         $w.ctxm add command -label "Copy" \
  51                 -command "tk_textCopy $w.m.t"
  52         $w.ctxm add command -label "Select All" \
  53                 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
  54         $w.ctxm add command -label "Copy All" \
  55                 -command "
  56                         $w.m.t tag add sel 0.0 end
  57                         tk_textCopy $w.m.t
  58                         $w.m.t tag remove sel 0.0 end
  59                 "
  60
  61         button $w.ok -text {Close} \
  62                 -state disabled \
  63                 -command "destroy $w"
  64         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
  65
  66         bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
  67         bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
  68         bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
  69         bind $w <Visibility> "focus $w"
  70         wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
  71         return $w
  72 }
  73
  74 proc exec {w cmd {after {}}} {
  75         # -- Cygwin's Tcl tosses the enviroment when we exec our child.
  76         #    But most users need that so we have to relogin. :-(
  77         #
  78         if {[is_Cygwin]} {
  79                 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
  80         }
  81
  82         # -- Tcl won't let us redirect both stdout and stderr to
  83         #    the same pipe.  So pass it through cat...
  84         #
  85         set cmd [concat | $cmd |& cat]
  86
  87         set fd_f [open $cmd r]
  88         fconfigure $fd_f -blocking 0 -translation binary
  89         fileevent $fd_f readable \
  90                 [namespace code [list _read $w $fd_f $after]]
  91 }
  92
  93 proc _read {w fd after} {
  94         variable console_cr
  95
  96         set buf [read $fd]
  97         if {$buf ne {}} {
  98                 if {![winfo exists $w]} {_init $w}
  99                 $w.m.t conf -state normal
 100                 set c 0
 101                 set n [string length $buf]
 102                 while {$c < $n} {
 103                         set cr [string first "\r" $buf $c]
 104                         set lf [string first "\n" $buf $c]
 105                         if {$cr < 0} {set cr [expr {$n + 1}]}
 106                         if {$lf < 0} {set lf [expr {$n + 1}]}
 107
 108                         if {$lf < $cr} {
 109                                 $w.m.t insert end [string range $buf $c $lf]
 110                                 set console_cr($w) [$w.m.t index {end -1c}]
 111                                 set c $lf
 112                                 incr c
 113                         } else {
 114                                 $w.m.t delete $console_cr($w) end
 115                                 $w.m.t insert end "\n"
 116                                 $w.m.t insert end [string range $buf $c $cr]
 117                                 set c $cr
 118                                 incr c
 119                         }
 120                 }
 121                 $w.m.t conf -state disabled
 122                 $w.m.t see end
 123         }
 124
 125         fconfigure $fd -blocking 1
 126         if {[eof $fd]} {
 127                 if {[catch {close $fd}]} {
 128                         set ok 0
 129                 } else {
 130                         set ok 1
 131                 }
 132                 if {$after ne {}} {
 133                         uplevel #0 $after $w $ok
 134                 } else {
 135                         done $w $ok
 136                 }
 137                 return
 138         }
 139         fconfigure $fd -blocking 0
 140 }
 141
 142 proc chain {cmdlist w {ok 1}} {
 143         if {$ok} {
 144                 if {[llength $cmdlist] == 0} {
 145                         done $w $ok
 146                         return
 147                 }
 148
 149                 set cmd [lindex $cmdlist 0]
 150                 set cmdlist [lrange $cmdlist 1 end]
 151
 152                 if {[lindex $cmd 0] eq {exec}} {
 153                         exec $w \
 154                                 [lindex $cmd 1] \
 155                                 [namespace code [list chain $cmdlist]]
 156                 } else {
 157                         uplevel #0 $cmd $cmdlist $w $ok
 158                 }
 159         } else {
 160                 done $w $ok
 161         }
 162 }
 163
 164 proc done {args} {
 165         variable console_cr
 166         variable console_data
 167
 168         switch -- [llength $args] {
 169         2 {
 170                 set w [lindex $args 0]
 171                 set ok [lindex $args 1]
 172         }
 173         3 {
 174                 set w [lindex $args 1]
 175                 set ok [lindex $args 2]
 176         }
 177         default {
 178                 error "wrong number of args: done ?ignored? w ok"
 179         }
 180         }
 181
 182         if {$ok} {
 183                 if {[winfo exists $w]} {
 184                         $w.m.s conf -background green -text {Success}
 185                         $w.ok conf -state normal
 186                         focus $w.ok
 187                 }
 188         } else {
 189                 if {![winfo exists $w]} {
 190                         _init $w
 191                 }
 192                 $w.m.s conf -background red -text {Error: Command Failed}
 193                 $w.ok conf -state normal
 194                 focus $w.ok
 195         }
 196
 197         array unset console_cr $w
 198         array unset console_data $w
 199 }
 200
 201 }