blob: 297e8defa47c19769093880a16bf5b89b0078d63 [file] [log] [blame]
Shawn O. Pearcef522c9b2007-05-07 23:35:48 -04001# git-gui console support
2# Copyright (C) 2006, 2007 Shawn Pearce
3
Shawn O. Pearcec74b6c62007-05-08 20:33:47 -04004class console {
Shawn O. Pearcef522c9b2007-05-07 23:35:48 -04005
Shawn O. Pearcec74b6c62007-05-08 20:33:47 -04006field t_short
7field t_long
8field w
9field console_cr
Shawn O. Pearceba1964b2007-07-05 02:23:53 -040010field is_toplevel 1; # are we our own window?
Shawn O. Pearcea35d65d2007-05-01 02:59:53 -040011
Shawn O. Pearcec74b6c62007-05-08 20:33:47 -040012constructor 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. Pearcef522c9b2007-05-07 23:35:48 -040017}
18
Shawn O. Pearceba1964b2007-07-05 02:23:53 -040019constructor 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. Pearcec74b6c62007-05-08 20:33:47 -040028method _init {} {
Shawn O. Pearcea35d65d2007-05-01 02:59:53 -040029 global M1B
Shawn O. Pearceba1964b2007-07-05 02:23:53 -040030
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. Pearcec74b6c62007-05-08 20:33:47 -040038 set console_cr 1.0
Shawn O. Pearcef522c9b2007-05-07 23:35:48 -040039
Shawn O. Pearcef522c9b2007-05-07 23:35:48 -040040 frame $w.m
Shawn O. Pearcec74b6c62007-05-08 20:33:47 -040041 label $w.m.l1 \
42 -textvariable @t_long \
Shawn O. Pearcef522c9b2007-05-07 23:35:48 -040043 -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. Pearceba1964b2007-07-05 02:23:53 -040076 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. Pearcef522c9b2007-05-07 23:35:48 -040083
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. Pearcef522c9b2007-05-07 23:35:48 -040087}
88
Shawn O. Pearcec74b6c62007-05-08 20:33:47 -040089method exec {cmd {after {}}} {
Shawn O. Pearcef522c9b2007-05-07 23:35:48 -040090 # -- 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. Pearcec74b6c62007-05-08 20:33:47 -0400104 fileevent $fd_f readable [cb _read $fd_f $after]
Shawn O. Pearcef522c9b2007-05-07 23:35:48 -0400105}
106
Shawn O. Pearcec74b6c62007-05-08 20:33:47 -0400107method _read {fd after} {
Shawn O. Pearcef522c9b2007-05-07 23:35:48 -0400108 set buf [read $fd]
109 if {$buf ne {}} {
Shawn O. Pearcec74b6c62007-05-08 20:33:47 -0400110 if {![winfo exists $w.m.t]} {_init $this}
Shawn O. Pearcef522c9b2007-05-07 23:35:48 -0400111 $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. Pearcec74b6c62007-05-08 20:33:47 -0400122 set console_cr [$w.m.t index {end -1c}]
Shawn O. Pearcef522c9b2007-05-07 23:35:48 -0400123 set c $lf
124 incr c
125 } else {
Shawn O. Pearcec74b6c62007-05-08 20:33:47 -0400126 $w.m.t delete $console_cr end
Shawn O. Pearcef522c9b2007-05-07 23:35:48 -0400127 $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. Pearcea35d65d2007-05-01 02:59:53 -0400144 if {$after ne {}} {
Shawn O. Pearcec74b6c62007-05-08 20:33:47 -0400145 uplevel #0 $after $ok
Shawn O. Pearcea35d65d2007-05-01 02:59:53 -0400146 } else {
Shawn O. Pearcec74b6c62007-05-08 20:33:47 -0400147 done $this $ok
Shawn O. Pearcea35d65d2007-05-01 02:59:53 -0400148 }
Shawn O. Pearcef522c9b2007-05-07 23:35:48 -0400149 return
150 }
151 fconfigure $fd -blocking 0
152}
153
Shawn O. Pearcec74b6c62007-05-08 20:33:47 -0400154method chain {cmdlist {ok 1}} {
Shawn O. Pearcef522c9b2007-05-07 23:35:48 -0400155 if {$ok} {
156 if {[llength $cmdlist] == 0} {
Shawn O. Pearcec74b6c62007-05-08 20:33:47 -0400157 done $this $ok
Shawn O. Pearcef522c9b2007-05-07 23:35:48 -0400158 return
159 }
160
161 set cmd [lindex $cmdlist 0]
162 set cmdlist [lrange $cmdlist 1 end]
163
Shawn O. Pearcea35d65d2007-05-01 02:59:53 -0400164 if {[lindex $cmd 0] eq {exec}} {
Shawn O. Pearcec74b6c62007-05-08 20:33:47 -0400165 exec $this \
166 [lrange $cmd 1 end] \
167 [cb chain $cmdlist]
Shawn O. Pearcef522c9b2007-05-07 23:35:48 -0400168 } else {
Shawn O. Pearcec74b6c62007-05-08 20:33:47 -0400169 uplevel #0 $cmd [cb chain $cmdlist]
Shawn O. Pearcef522c9b2007-05-07 23:35:48 -0400170 }
171 } else {
Shawn O. Pearcec74b6c62007-05-08 20:33:47 -0400172 done $this $ok
Shawn O. Pearcef522c9b2007-05-07 23:35:48 -0400173 }
174}
175
Shawn O. Pearcec74b6c62007-05-08 20:33:47 -0400176method done {ok} {
Shawn O. Pearcef522c9b2007-05-07 23:35:48 -0400177 if {$ok} {
Shawn O. Pearcec74b6c62007-05-08 20:33:47 -0400178 if {[winfo exists $w.m.s]} {
Shawn O. Pearcef522c9b2007-05-07 23:35:48 -0400179 $w.m.s conf -background green -text {Success}
Shawn O. Pearceba1964b2007-07-05 02:23:53 -0400180 if {$is_toplevel} {
181 $w.ok conf -state normal
182 focus $w.ok
183 }
Shawn O. Pearcef522c9b2007-05-07 23:35:48 -0400184 }
185 } else {
Shawn O. Pearcec74b6c62007-05-08 20:33:47 -0400186 if {![winfo exists $w.m.s]} {
187 _init $this
Shawn O. Pearcef522c9b2007-05-07 23:35:48 -0400188 }
189 $w.m.s conf -background red -text {Error: Command Failed}
Shawn O. Pearceba1964b2007-07-05 02:23:53 -0400190 if {$is_toplevel} {
191 $w.ok conf -state normal
192 focus $w.ok
193 }
Shawn O. Pearcef522c9b2007-05-07 23:35:48 -0400194 }
Shawn O. Pearcec74b6c62007-05-08 20:33:47 -0400195 delete_this
Shawn O. Pearcef522c9b2007-05-07 23:35:48 -0400196}
Shawn O. Pearcea35d65d2007-05-01 02:59:53 -0400197
198}