1 # git-gui console support
2 # Copyright (C) 2006, 2007 Shawn Pearce
10 field is_toplevel
1; # are we our own window?
12 constructor new
{short_title long_title
} {
13 set t_short
$short_title
14 set t_long
$long_title
19 constructor embed
{path title
} {
32 make_toplevel top w
-autodelete 0
33 wm title
$top "[appname] ([reponame]): $t_short"
42 -textvariable @t_long
\
47 -background white
-borderwidth 1 \
49 -width 80 -height 10 \
52 -yscrollcommand [list $w.m.sby
set]
53 label $w.m.s
-text {Working... please wait...
} \
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
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" \
71 $w.m.t tag add sel 0.0 end
73 $w.m.t tag remove sel 0.0 end
77 button $w.ok
-text {Close
} \
79 -command [list destroy $w]
80 pack $w.ok
-side bottom
-anchor e
-pady 10 -padx 10
81 bind $w <Visibility
> [list focus $w]
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"
89 method
exec {cmd
{after {}}} {
90 # -- Cygwin's Tcl tosses the enviroment when we exec our child.
91 # But most users need that so we have to relogin. :-(
94 set cmd
[list sh
--login -c "cd \"[pwd]\" && [join $cmd { }]"]
97 # -- Tcl won't let us redirect both stdout and stderr to
98 # the same pipe. So pass it through cat...
100 set cmd
[concat |
$cmd |
& cat
]
102 set fd_f
[open $cmd r
]
103 fconfigure $fd_f -blocking 0 -translation binary
104 fileevent $fd_f readable
[cb _read
$fd_f $after]
107 method _read
{fd
after} {
110 if {![winfo exists
$w.m.t
]} {_init
$this}
111 $w.m.t conf
-state normal
113 set n
[string length
$buf]
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}]}
121 $w.m.t insert end
[string range
$buf $c $lf]
122 set console_cr
[$w.m.t index
{end
-1c}]
126 $w.m.t delete
$console_cr end
127 $w.m.t insert end
"\n"
128 $w.m.t insert end
[string range
$buf $c $cr]
133 $w.m.t conf
-state disabled
137 fconfigure $fd -blocking 1
139 if {[catch {close $fd}]} {
145 uplevel #0 $after $ok
151 fconfigure $fd -blocking 0
154 method chain
{cmdlist
{ok
1}} {
156 if {[llength $cmdlist] == 0} {
161 set cmd
[lindex $cmdlist 0]
162 set cmdlist
[lrange $cmdlist 1 end
]
164 if {[lindex $cmd 0] eq
{exec}} {
166 [lrange $cmd 1 end
] \
169 uplevel #0 $cmd [cb chain $cmdlist]
178 if {[winfo exists
$w.m.s
]} {
179 $w.m.s conf
-background green
-text {Success
}
181 $w.ok conf
-state normal
186 if {![winfo exists
$w.m.s
]} {
189 $w.m.s conf
-background red
-text {Error
: Command Failed
}
191 $w.ok conf
-state normal