lib/console.tcl

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