git-gui: Always use absolute path to all git executables

Rather than making the C library search for git every time we want
to execute it we now search for the main git wrapper at startup, do
symlink resolution, and then always use the absolute path that we
found to execute the binary later on.  This should save us some
cycles, especially on stat challenged systems like Cygwin/Win32.

While I was working on this change I also converted all of our
existing pipes ([open "| git ..."]) to use two new pipe wrapper
functions.  These functions take additional options like --nice
and --stderr which instructs Tcl to take special action, like
running the underlying git program through `nice` (if available)
or redirect stderr to stdout for capture in Tcl.

Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
This commit is contained in:
Shawn O. Pearce 2007-07-09 01:17:09 -04:00
parent b79223064e
commit 0b81261622
13 changed files with 258 additions and 84 deletions

View File

@ -117,6 +117,7 @@ set _gitdir {}
set _gitexec {}
set _reponame {}
set _iscygwin {}
set _search_path {}
proc appname {} {
global _appname
@ -128,7 +129,7 @@ proc gitdir {args} {
if {$args eq {}} {
return $_gitdir
}
return [eval [concat [list file join $_gitdir] $args]]
return [eval [list file join $_gitdir] $args]
}
proc gitexec {args} {
@ -137,11 +138,19 @@ proc gitexec {args} {
if {[catch {set _gitexec [git --exec-path]} err]} {
error "Git not installed?\n\n$err"
}
if {[is_Cygwin]} {
set _gitexec [exec cygpath \
--windows \
--absolute \
$_gitexec]
} else {
set _gitexec [file normalize $_gitexec]
}
}
if {$args eq {}} {
return $_gitexec
}
return [eval [concat [list file join $_gitexec] $args]]
return [eval [list file join $_gitexec] $args]
}
proc reponame {} {
@ -237,7 +246,7 @@ proc load_config {include_global} {
array unset global_config
if {$include_global} {
catch {
set fd_rc [open "| git config --global --list" r]
set fd_rc [git_read config --global --list]
while {[gets $fd_rc line] >= 0} {
if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
if {[is_many_config $name]} {
@ -253,7 +262,7 @@ proc load_config {include_global} {
array unset repo_config
catch {
set fd_rc [open "| git config --list" r]
set fd_rc [git_read config --list]
while {[gets $fd_rc line] >= 0} {
if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
if {[is_many_config $name]} {
@ -280,8 +289,172 @@ proc load_config {include_global} {
##
## handy utils
proc _git_cmd {name} {
global _git_cmd_path
if {[catch {set v $_git_cmd_path($name)}]} {
switch -- $name {
--version -
--exec-path { return [list $::_git $name] }
}
set p [gitexec git-$name$::_search_exe]
if {[file exists $p]} {
set v [list $p]
} elseif {[is_Cygwin]} {
# On Cygwin git is a proper Cygwin program and knows
# how to properly restart the Cygwin environment and
# spawn its non-.exe support program.
#
set v [list $::_git $name]
} elseif {[is_Windows]
&& $::_sh ne {}
&& [file exists [gitexec git-$name]]} {
# Assume this is a UNIX shell script. We can
# probably execute it through a Bourne shell.
#
set v [list $::_sh [gitexec git-$name]]
} else {
error "No [gitexec git-$name]"
}
set _git_cmd_path($name) $v
}
return $v
}
proc _which {what} {
global env _search_exe _search_path
if {$_search_path eq {}} {
if {[is_Cygwin]} {
set _search_path [split [exec cygpath \
--windows \
--path \
--absolute \
$env(PATH)] {;}]
set _search_exe .exe
} elseif {[is_Windows]} {
set _search_path [split $env(PATH) {;}]
set _search_exe .exe
} else {
set _search_path [split $env(PATH) :]
set _search_exe {}
}
}
foreach p $_search_path {
set p [file join $p $what$_search_exe]
if {[file exists $p]} {
return [file normalize $p]
}
}
return {}
}
proc git {args} {
return [eval exec git $args]
set opt [list exec]
while {1} {
switch -- [lindex $args 0] {
--nice {
global _nice
if {$_nice ne {}} {
lappend opt $_nice
}
}
default {
break
}
}
set args [lrange $args 1 end]
}
set cmdp [_git_cmd [lindex $args 0]]
set args [lrange $args 1 end]
return [eval $opt $cmdp $args]
}
proc git_read {args} {
set opt [list |]
while {1} {
switch -- [lindex $args 0] {
--nice {
global _nice
if {$_nice ne {}} {
lappend opt $_nice
}
}
--stderr {
lappend args 2>@1
}
default {
break
}
}
set args [lrange $args 1 end]
}
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
}
proc git_write {args} {
set opt [list |]
while {1} {
switch -- [lindex $args 0] {
--nice {
global _nice
if {$_nice ne {}} {
lappend opt $_nice
}
}
default {
break
}
}
set args [lrange $args 1 end]
}
set cmdp [_git_cmd [lindex $args 0]]
set args [lrange $args 1 end]
return [open [concat $opt $cmdp $args] w]
}
proc load_current_branch {} {
@ -318,6 +491,19 @@ proc tk_optionMenu {w varName args} {
return $m
}
######################################################################
##
## find git
set _git [_which git]
if {$_git eq {}} {
catch {wm withdraw .}
error_popup "Cannot find git in PATH."
exit 1
}
set _nice [_which nice]
set _sh [_which sh]
######################################################################
##
## version check
@ -566,12 +752,12 @@ proc rescan {after {honor_trustmtime 1}} {
} else {
set rescan_active 1
ui_status {Refreshing file status...}
set cmd [list git update-index]
lappend cmd -q
lappend cmd --unmerged
lappend cmd --ignore-missing
lappend cmd --refresh
set fd_rf [open "| $cmd" r]
set fd_rf [git_read update-index \
-q \
--unmerged \
--ignore-missing \
--refresh \
]
fconfigure $fd_rf -blocking 0 -translation binary
fileevent $fd_rf readable \
[list rescan_stage2 $fd_rf $after]
@ -587,8 +773,7 @@ proc rescan_stage2 {fd after} {
close $fd
}
set ls_others [list | git ls-files --others -z \
--exclude-per-directory=.gitignore]
set ls_others [list --exclude-per-directory=.gitignore]
set info_exclude [gitdir info exclude]
if {[file readable $info_exclude]} {
lappend ls_others "--exclude-from=$info_exclude"
@ -600,9 +785,9 @@ proc rescan_stage2 {fd after} {
set rescan_active 3
ui_status {Scanning for modified files ...}
set fd_di [open "| git diff-index --cached -z [PARENT]" r]
set fd_df [open "| git diff-files -z" r]
set fd_lo [open $ls_others r]
set fd_di [git_read diff-index --cached -z [PARENT]]
set fd_df [git_read diff-files -z]
set fd_lo [eval git_read ls-files --others -z $ls_others]
fconfigure $fd_di -blocking 0 -translation binary -encoding binary
fconfigure $fd_df -blocking 0 -translation binary -encoding binary

View File

@ -371,8 +371,7 @@ method _load {jump} {
if {$commit eq {}} {
set fd [open $path r]
} else {
set cmd [list git cat-file blob "$commit:$path"]
set fd [open "| $cmd" r]
set fd [git_read cat-file blob "$commit:$path"]
}
fconfigure $fd -blocking 0 -translation lf -encoding binary
fileevent $fd readable [cb _read_file $fd $jump]
@ -475,20 +474,14 @@ method _read_file {fd jump} {
} ifdeleted { catch {close $fd} }
method _exec_blame {cur_w cur_d options cur_s} {
set cmd [list]
if {![is_Windows] || [is_Cygwin]} {
lappend cmd nice
}
lappend cmd git blame
set cmd [concat $cmd $options]
lappend cmd --incremental
lappend options --incremental
if {$commit eq {}} {
lappend cmd --contents $path
lappend options --contents $path
} else {
lappend cmd $commit
lappend options $commit
}
lappend cmd -- $path
set fd [open "| $cmd" r]
lappend options -- $path
set fd [eval git_read --nice blame $options]
fconfigure $fd -blocking 0 -translation lf -encoding binary
fileevent $fd readable [cb _read_blame $fd $cur_w $cur_d]
set current_fd $fd
@ -767,7 +760,7 @@ method _showcommit {cur_w lno} {
if {[catch {set msg $header($cmit,message)}]} {
set msg {}
catch {
set fd [open "| git cat-file commit $cmit" r]
set fd [git_read cat-file commit $cmit]
fconfigure $fd -encoding binary -translation lf
if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
set enc utf-8

View File

@ -7,7 +7,7 @@ proc load_all_heads {} {
set rh refs/heads
set rh_len [expr {[string length $rh] + 1}]
set all_heads [list]
set fd [open "| git for-each-ref --format=%(refname) $rh" r]
set fd [git_read for-each-ref --format=%(refname) $rh]
while {[gets $fd line] > 0} {
if {!$some_heads_tracking || ![is_tracking_branch $line]} {
lappend all_heads [string range $line $rh_len end]
@ -20,7 +20,10 @@ proc load_all_heads {} {
proc load_all_tags {} {
set all_tags [list]
set fd [open "| git for-each-ref --sort=-taggerdate --format=%(refname) refs/tags" r]
set fd [git_read for-each-ref \
--sort=-taggerdate \
--format=%(refname) \
refs/tags]
while {[gets $fd line] > 0} {
if {![regsub ^refs/tags/ $line {} name]} continue
lappend all_tags $name

View File

@ -178,8 +178,7 @@ method _ls {tree_id {name {}}} {
lappend browser_stack [list $tree_id $name]
$w conf -state disabled
set cmd [list git ls-tree -z $tree_id]
set fd [open "| $cmd" r]
set fd [git_read ls-tree -z $tree_id]
fconfigure $fd -blocking 0 -translation binary -encoding binary
fileevent $fd readable [cb _read $fd]
}

View File

@ -274,12 +274,12 @@ The rescan will be automatically started now.
_readtree $this
} else {
ui_status {Refreshing file status...}
set cmd [list git update-index]
lappend cmd -q
lappend cmd --unmerged
lappend cmd --ignore-missing
lappend cmd --refresh
set fd [open "| $cmd" r]
set fd [git_read update-index \
-q \
--unmerged \
--ignore-missing \
--refresh \
]
fconfigure $fd -blocking 0 -translation binary
fileevent $fd readable [cb _refresh_wait $fd]
}
@ -315,23 +315,14 @@ method _readtree {} {
"Updating working directory to '[_name $this]'..." \
{files checked out}
set cmd [list git read-tree]
lappend cmd -m
lappend cmd -u
lappend cmd -v
lappend cmd --exclude-per-directory=.gitignore
lappend cmd $HEAD
lappend cmd $new_hash
if {[catch {
set fd [open "| $cmd 2>@1" r]
} err]} {
# Older versions of Tcl 8.4 don't have this 2>@1 IO
# redirect operator. Fallback to |& cat for those.
#
set fd [open "| $cmd |& cat" r]
}
set fd [git_read --stderr read-tree \
-m \
-u \
-v \
--exclude-per-directory=.gitignore \
$HEAD \
$new_hash \
]
fconfigure $fd -blocking 0 -translation binary
fileevent $fd readable [cb _readtree_wait $fd]
}
@ -524,7 +515,7 @@ method _confirm_reset {cur} {
pack $w.buttons.cancel -side right -padx 5
pack $w.buttons -side bottom -fill x -pady 10 -padx 10
set fd [open "| git rev-list --pretty=oneline $cur ^$new_hash" r]
set fd [git_read rev-list --pretty=oneline $cur ^$new_hash]
while {[gets $fd line] > 0} {
set abbr [string range $line 0 7]
set subj [string range $line 41 end]

View File

@ -25,7 +25,7 @@ You are currently in the middle of a merge that has not been fully completed. Y
set msg {}
set parents [list]
if {[catch {
set fd [open "| git cat-file commit $curHEAD" r]
set fd [git_read cat-file commit $curHEAD]
fconfigure $fd -encoding binary -translation lf
if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
set enc utf-8
@ -235,7 +235,7 @@ proc commit_prehook_wait {fd_ph curHEAD msg} {
proc commit_writetree {curHEAD msg} {
ui_status {Committing changes...}
set fd_wt [open "| git write-tree" r]
set fd_wt [git_read write-tree]
fileevent $fd_wt readable \
[list commit_committree $fd_wt $curHEAD $msg]
}

View File

@ -2,7 +2,7 @@
# Copyright (C) 2006, 2007 Shawn Pearce
proc do_stats {} {
set fd [open "| git count-objects -v" r]
set fd [git_read count-objects -v]
while {[gets $fd line] > 0} {
if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
set stats($name) $value

View File

@ -131,7 +131,7 @@ proc show_diff {path w {lno {}}} {
return
}
set cmd [list | git]
set cmd [list]
if {$w eq $ui_index} {
lappend cmd diff-index
lappend cmd --cached
@ -154,7 +154,7 @@ proc show_diff {path w {lno {}}} {
lappend cmd --
lappend cmd $path
if {[catch {set fd [open $cmd r]} err]} {
if {[catch {set fd [eval git_read --nice $cmd]} err]} {
set diff_active 0
unlock_index
ui_status "Unable to display [escape_path $path]"
@ -271,7 +271,7 @@ proc apply_hunk {x y} {
if {$current_diff_path eq {} || $current_diff_header eq {}} return
if {![lock_index apply_hunk]} return
set apply_cmd {git apply --cached --whitespace=nowarn}
set apply_cmd {apply --cached --whitespace=nowarn}
set mi [lindex $file_states($current_diff_path) 0]
if {$current_diff_side eq $ui_index} {
set mode unstage
@ -301,7 +301,7 @@ proc apply_hunk {x y} {
}
if {[catch {
set p [open "| $apply_cmd" w]
set p [eval git_write $apply_cmd]
fconfigure $p -translation binary -encoding binary
puts -nonewline $p $current_diff_header
puts -nonewline $p [$ui_diff get $s_lno $e_lno]

View File

@ -17,7 +17,7 @@ proc update_indexinfo {msg pathList after} {
$update_index_cp \
$totalCnt \
0.0]
set fd [open "| git update-index -z --index-info" w]
set fd [git_write update-index -z --index-info]
fconfigure $fd \
-blocking 0 \
-buffering full \
@ -90,7 +90,7 @@ proc update_index {msg pathList after} {
$update_index_cp \
$totalCnt \
0.0]
set fd [open "| git update-index --add --remove -z --stdin" w]
set fd [git_write update-index --add --remove -z --stdin]
fconfigure $fd \
-blocking 0 \
-buffering full \
@ -167,13 +167,13 @@ proc checkout_index {msg pathList after} {
$update_index_cp \
$totalCnt \
0.0]
set cmd [list git checkout-index]
lappend cmd --index
lappend cmd --quiet
lappend cmd --force
lappend cmd -z
lappend cmd --stdin
set fd [open "| $cmd " w]
set fd [git_write checkout-index \
--index \
--quiet \
--force \
-z \
--stdin \
]
fconfigure $fd \
-blocking 0 \
-buffering full \

View File

@ -146,7 +146,7 @@ The working directory will now be reset.
You can attempt this merge again by merging only one branch at a time." $w
set fd [open "| git read-tree --reset -u HEAD" r]
set fd [git_read read-tree --reset -u HEAD]
fconfigure $fd -blocking 0 -translation binary
fileevent $fd readable \
[namespace code [list _reset_wait $fd]]
@ -167,11 +167,13 @@ proc dialog {} {
if {![_can_merge]} return
set fmt {list %(objectname) %(*objectname) %(refname) %(subject)}
set cmd [list git for-each-ref --tcl --format=$fmt]
lappend cmd refs/heads
lappend cmd refs/remotes
lappend cmd refs/tags
set fr_fd [open "| $cmd" r]
set fr_fd [git_read for-each-ref \
--tcl \
--format=$fmt \
refs/heads \
refs/remotes \
refs/tags \
]
fconfigure $fr_fd -translation binary
while {[gets $fr_fd line] > 0} {
set line [eval $line]
@ -186,7 +188,7 @@ proc dialog {} {
close $fr_fd
set to_show {}
set fr_fd [open "| git rev-list --all --not HEAD"]
set fr_fd [git_read rev-list --all --not HEAD]
while {[gets $fr_fd line] > 0} {
if {[catch {set ref $sha1($line)}]} continue
foreach n $ref {
@ -282,7 +284,7 @@ You must finish amending this commit.
Aborting the current $op will cause *ALL* uncommitted changes to be lost.
Continue with aborting the current $op?"] eq {yes}} {
set fd [open "| git read-tree --reset -u HEAD" r]
set fd [git_read read-tree --reset -u HEAD]
fconfigure $fd -blocking 0 -translation binary
fileevent $fd readable [namespace code [list _reset_wait $fd]]
ui_status {Aborting... please wait...}

View File

@ -95,6 +95,7 @@ $copyright" \
}
set d {}
append d "git wrapper: $::_git\n"
append d "git exec dir: [gitexec]\n"
append d "git-gui lib: $oguilib"

View File

@ -32,7 +32,7 @@ proc all_tracking_branches {} {
}
if {$pat ne {}} {
set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
set fd [eval git_read for-each-ref --format=%(refname) $cmd]
while {[gets $fd n] > 0} {
foreach spec $pat {
set dst [string range [lindex $spec 0] 0 end-2]

View File

@ -296,7 +296,7 @@ method _load {cache uri} {
set full_list [list]
set head_cache($cache) [list]
set full_cache($cache) [list]
set active_ls [open "| [list git ls-remote $uri]" r]
set active_ls [git_read ls-remote $uri]
fconfigure $active_ls \
-blocking 0 \
-translation lf \