set _gitexec {}
set _reponame {}
set _iscygwin {}
+set _search_path {}
proc appname {} {
global _appname
if {$args eq {}} {
return $_gitdir
}
- return [eval [concat [list file join $_gitdir] $args]]
+ return [eval [list file join $_gitdir] $args]
}
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 {} {
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]} {
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]} {
##
## 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 {} {
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
} 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]
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"
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
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]
} 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
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
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]
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
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]
}
_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]
}
"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]
}
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]
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
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]
}
# 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
return
}
- set cmd [list | git]
+ set cmd [list]
if {$w eq $ui_index} {
lappend cmd diff-index
lappend cmd --cached
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]"
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
}
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]
$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 \
$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 \
$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 \
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]]
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]
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 {
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...}
}
set d {}
+ append d "git wrapper: $::_git\n"
append d "git exec dir: [gitexec]\n"
append d "git-gui lib: $oguilib"
}
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]
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 \