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