summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: c136f2b)
raw | patch | inline | side by side (parent: c136f2b)
author | Shawn O. Pearce <spearce@spearce.org> | |
Mon, 9 Jul 2007 07:07:05 +0000 (03:07 -0400) | ||
committer | Shawn O. Pearce <spearce@spearce.org> | |
Mon, 9 Jul 2007 07:07:05 +0000 (03:07 -0400) |
Now that we are pretty strict about setting up own absolute paths to
any git helper (saving a marginal runtime cost to resolve the tool)
we can do the same in our console widget by making sure all console
execs go through git_read if they are a git subcommand, and if not
make sure they at least try to use the Tcl 2>@1 IO redirection if
possible, as it should be faster than |& cat.
Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
any git helper (saving a marginal runtime cost to resolve the tool)
we can do the same in our console widget by making sure all console
execs go through git_read if they are a git subcommand, and if not
make sure they at least try to use the Tcl 2>@1 IO redirection if
possible, as it should be faster than |& cat.
Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
git-gui.sh | patch | blob | history | |
lib/console.tcl | patch | blob | history |
diff --git a/git-gui.sh b/git-gui.sh
index 7e6952c2bc0d31e8028f80573b846af90be9dc6f..3efecdd962bf7f0f2db63f53348eac0dfdf68f25 100755 (executable)
--- a/git-gui.sh
+++ b/git-gui.sh
return [eval $opt $cmdp $args]
}
+proc _open_stdout_stderr {cmd} {
+ if {[catch {
+ set fd [open $cmd r]
+ } err]} {
+ if { [lindex $cmd end] eq {2>@1}
+ && $err eq {can not find channel named "1"}
+ } {
+ # Older versions of Tcl 8.4 don't have this 2>@1 IO
+ # redirect operator. Fallback to |& cat for those.
+ # The command was not actually started, so its safe
+ # to try to start it a second time.
+ #
+ set fd [open [concat \
+ [lrange $cmd 0 end-1] \
+ [list |& cat] \
+ ] r]
+ } else {
+ error $err
+ }
+ }
+ return $fd
+}
+
proc git_read {args} {
set opt [list |]
set cmdp [_git_cmd [lindex $args 0]]
set args [lrange $args 1 end]
- if {[catch {
- set fd [open [concat $opt $cmdp $args] r]
- } err]} {
- if { [lindex $args end] eq {2>@1}
- && $err eq {can not find channel named "1"}
- } {
- # Older versions of Tcl 8.4 don't have this 2>@1 IO
- # redirect operator. Fallback to |& cat for those.
- # The command was not actually started, so its safe
- # to try to start it a second time.
- #
- set fd [open [concat \
- $opt \
- $cmdp \
- [lrange $args 0 end-1] \
- [list |& cat] \
- ] r]
- } else {
- error $err
- }
- }
- return $fd
+ return [_open_stdout_stderr [concat $opt $cmdp $args]]
}
proc git_write {args} {
diff --git a/lib/console.tcl b/lib/console.tcl
index 27a880e408fbdcf1f9caf66adf92f42403538341..03d0354d5ee4934b93784e949e07c694bd325236 100644 (file)
--- a/lib/console.tcl
+++ b/lib/console.tcl
}
method exec {cmd {after {}}} {
- # -- Cygwin's Tcl tosses the enviroment when we exec our child.
- # But most users need that so we have to relogin. :-(
- #
- if {[is_Cygwin]} {
- set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
+ if {[lindex $cmd 0] eq {git}} {
+ set fd_f [eval git_read --stderr [lrange $cmd 1 end]]
+ } else {
+ lappend cmd 2>@1
+ set fd_f [_open_stdout_stderr $cmd]
}
-
- # -- Tcl won't let us redirect both stdout and stderr to
- # the same pipe. So pass it through cat...
- #
- set cmd [concat | $cmd |& cat]
-
- set fd_f [open $cmd r]
fconfigure $fd_f -blocking 0 -translation binary
fileevent $fd_f readable [cb _read $fd_f $after]
}