summaryrefslogtreecommitdiff
path: root/git-gui
diff options
context:
space:
mode:
Diffstat (limited to 'git-gui')
-rwxr-xr-xgit-gui/GIT-VERSION-GEN2
-rw-r--r--git-gui/Makefile42
-rwxr-xr-xgit-gui/git-gui.sh935
-rw-r--r--git-gui/lib/blame.tcl111
-rw-r--r--git-gui/lib/branch.tcl562
-rw-r--r--git-gui/lib/branch_checkout.tcl89
-rw-r--r--git-gui/lib/branch_create.tcl220
-rw-r--r--git-gui/lib/branch_delete.tcl149
-rw-r--r--git-gui/lib/branch_rename.tcl128
-rw-r--r--git-gui/lib/browser.tcl88
-rw-r--r--git-gui/lib/checkout_op.tcl588
-rw-r--r--git-gui/lib/choose_rev.tcl627
-rw-r--r--git-gui/lib/class.tcl38
-rw-r--r--git-gui/lib/commit.tcl84
-rw-r--r--git-gui/lib/console.tcl69
-rw-r--r--git-gui/lib/database.tcl29
-rw-r--r--git-gui/lib/diff.tcl27
-rw-r--r--git-gui/lib/encoding.tcl276
-rw-r--r--git-gui/lib/error.tcl7
-rw-r--r--git-gui/lib/index.tcl50
-rw-r--r--git-gui/lib/merge.tcl285
-rw-r--r--git-gui/lib/option.tcl19
-rw-r--r--git-gui/lib/remote.tcl106
-rw-r--r--git-gui/lib/remote_branch_delete.tcl347
-rw-r--r--git-gui/lib/shortcut.tcl51
-rw-r--r--git-gui/lib/status_bar.tcl96
-rw-r--r--git-gui/lib/transport.tcl20
27 files changed, 3800 insertions, 1245 deletions
diff --git a/git-gui/GIT-VERSION-GEN b/git-gui/GIT-VERSION-GEN
index eee495a..9770b0b 100755
--- a/git-gui/GIT-VERSION-GEN
+++ b/git-gui/GIT-VERSION-GEN
@@ -1,7 +1,7 @@
#!/bin/sh
GVF=GIT-VERSION-FILE
-DEF_VER=0.7.GITGUI
+DEF_VER=0.8.GITGUI
LF='
'
diff --git a/git-gui/Makefile b/git-gui/Makefile
index ab550fc..1bac6fe 100644
--- a/git-gui/Makefile
+++ b/git-gui/Makefile
@@ -31,11 +31,35 @@ ifndef INSTALL
INSTALL = install
endif
+INSTALL_D0 = $(INSTALL) -d -m755 # space is required here
+INSTALL_D1 =
+INSTALL_R0 = $(INSTALL) -m644 # space is required here
+INSTALL_R1 =
+INSTALL_X0 = $(INSTALL) -m755 # space is required here
+INSTALL_X1 =
+INSTALL_L0 = rm -f # space is required here
+INSTALL_L1 = && ln # space is required here
+INSTALL_L2 =
+INSTALL_L3 =
+
ifndef V
- QUIET_GEN = @echo ' ' GEN $@;
- QUIET_BUILT_IN = @echo ' ' BUILTIN $@;
- QUIET_INDEX = @echo ' ' INDEX $(dir $@);
+ QUIET = @
+ QUIET_GEN = $(QUIET)echo ' ' GEN $@ &&
+ QUIET_BUILT_IN = $(QUIET)echo ' ' BUILTIN $@ &&
+ QUIET_INDEX = $(QUIET)echo ' ' INDEX $(dir $@) &&
QUIET_2DEVNULL = 2>/dev/null
+
+ INSTALL_D0 = dir=
+ INSTALL_D1 = && echo ' ' DEST $$dir && $(INSTALL) -d -m755 "$$dir"
+ INSTALL_R0 = src=
+ INSTALL_R1 = && echo ' ' INSTALL 644 `basename $$src` && $(INSTALL) -m644 $$src
+ INSTALL_X0 = src=
+ INSTALL_X1 = && echo ' ' INSTALL 755 `basename $$src` && $(INSTALL) -m755 $$src
+
+ INSTALL_L0 = dst=
+ INSTALL_L1 = && src=
+ INSTALL_L2 = && dst=
+ INSTALL_L3 = && echo ' ' 'LINK ' `basename "$$dst"` '->' `basename "$$src"` && rm -f "$$dst" && ln "$$src" "$$dst"
endif
TCL_PATH ?= tclsh
@@ -115,12 +139,12 @@ GIT-GUI-VARS: .FORCE-GIT-GUI-VARS
all:: $(ALL_PROGRAMS) lib/tclIndex
install: all
- $(INSTALL) -d -m755 '$(DESTDIR_SQ)$(gitexecdir_SQ)'
- $(INSTALL) git-gui '$(DESTDIR_SQ)$(gitexecdir_SQ)'
- $(foreach p,$(GITGUI_BUILT_INS), rm -f '$(DESTDIR_SQ)$(gitexecdir_SQ)/$p' && ln '$(DESTDIR_SQ)$(gitexecdir_SQ)/git-gui' '$(DESTDIR_SQ)$(gitexecdir_SQ)/$p' ;)
- $(INSTALL) -d -m755 '$(DESTDIR_SQ)$(libdir_SQ)'
- $(INSTALL) -m644 lib/tclIndex '$(DESTDIR_SQ)$(libdir_SQ)'
- $(foreach p,$(ALL_LIBFILES), $(INSTALL) -m644 $p '$(DESTDIR_SQ)$(libdir_SQ)' ;)
+ $(QUIET)$(INSTALL_D0)'$(DESTDIR_SQ)$(gitexecdir_SQ)' $(INSTALL_D1)
+ $(QUIET)$(INSTALL_X0)git-gui $(INSTALL_X1) '$(DESTDIR_SQ)$(gitexecdir_SQ)'
+ $(QUIET)$(foreach p,$(GITGUI_BUILT_INS), $(INSTALL_L0)'$(DESTDIR_SQ)$(gitexecdir_SQ)/$p' $(INSTALL_L1)'$(DESTDIR_SQ)$(gitexecdir_SQ)/git-gui' $(INSTALL_L2)'$(DESTDIR_SQ)$(gitexecdir_SQ)/$p' $(INSTALL_L3) &&) true
+ $(QUIET)$(INSTALL_D0)'$(DESTDIR_SQ)$(libdir_SQ)' $(INSTALL_D1)
+ $(QUIET)$(INSTALL_R0)lib/tclIndex $(INSTALL_R1) '$(DESTDIR_SQ)$(libdir_SQ)'
+ $(QUIET)$(foreach p,$(ALL_LIBFILES), $(INSTALL_R0)$p $(INSTALL_R1) '$(DESTDIR_SQ)$(libdir_SQ)' &&) true
dist-version:
@mkdir -p $(TARDIR)
diff --git a/git-gui/git-gui.sh b/git-gui/git-gui.sh
index c38aa06..671b887 100755
--- a/git-gui/git-gui.sh
+++ b/git-gui/git-gui.sh
@@ -44,6 +44,24 @@ if {[catch {package require Tcl 8.4} err]
######################################################################
##
+## enable verbose loading?
+
+if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
+ unset _verbose
+ rename auto_load real__auto_load
+ proc auto_load {name args} {
+ puts stderr "auto_load $name"
+ return [uplevel 1 real__auto_load $name $args]
+ }
+ rename source real__source
+ proc source {name} {
+ puts stderr "source $name"
+ uplevel 1 real__source $name
+ }
+}
+
+######################################################################
+##
## configure our library
set oguilib {@@GITGUI_LIBDIR@@}
@@ -54,26 +72,33 @@ if {$oguirel eq {1}} {
} elseif {[string match @@* $oguirel]} {
set oguilib [file join [file dirname [file normalize $argv0]] lib]
}
+
set idx [file join $oguilib tclIndex]
-catch {
- set fd [open $idx r]
- if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
- set idx [list]
- while {[gets $fd n] >= 0} {
- if {$n ne {} && ![string match #* $n]} {
- lappend idx $n
- }
+if {[catch {set fd [open $idx r]} err]} {
+ catch {wm withdraw .}
+ tk_messageBox \
+ -icon error \
+ -type ok \
+ -title "git-gui: fatal error" \
+ -message $err
+ exit 1
+}
+if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
+ set idx [list]
+ while {[gets $fd n] >= 0} {
+ if {$n ne {} && ![string match #* $n]} {
+ lappend idx $n
}
- } else {
- set idx {}
}
- close $fd
+} else {
+ set idx {}
}
+close $fd
+
if {$idx ne {}} {
set loaded [list]
foreach p $idx {
if {[lsearch -exact $loaded $p] >= 0} continue
- puts $p
source [file join $oguilib $p]
lappend loaded $p
}
@@ -81,21 +106,7 @@ if {$idx ne {}} {
} else {
set auto_path [concat [list $oguilib] $auto_path]
}
-unset -nocomplain oguilib oguirel idx fd
-
-if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
- unset _verbose
- rename auto_load real__auto_load
- proc auto_load {name args} {
- puts stderr "auto_load $name"
- return [uplevel 1 real__auto_load $name $args]
- }
- rename source real__source
- proc source {name} {
- puts stderr "source $name"
- uplevel 1 real__source $name
- }
-}
+unset -nocomplain oguirel idx fd
######################################################################
##
@@ -106,6 +117,7 @@ set _gitdir {}
set _gitexec {}
set _reponame {}
set _iscygwin {}
+set _search_path {}
proc appname {} {
global _appname
@@ -117,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} {
@@ -126,20 +138,26 @@ 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 {} {
- global _reponame
- return $_reponame
+ return $::_reponame
}
proc is_MacOSX {} {
- global tcl_platform tk_library
if {[tk windowingsystem] eq {aqua}} {
return 1
}
@@ -147,17 +165,16 @@ proc is_MacOSX {} {
}
proc is_Windows {} {
- global tcl_platform
- if {$tcl_platform(platform) eq {windows}} {
+ if {$::tcl_platform(platform) eq {windows}} {
return 1
}
return 0
}
proc is_Cygwin {} {
- global tcl_platform _iscygwin
+ global _iscygwin
if {$_iscygwin eq {}} {
- if {$tcl_platform(platform) eq {windows}} {
+ if {$::tcl_platform(platform) eq {windows}} {
if {[catch {set p [exec cygpath --windir]} err]} {
set _iscygwin 0
} else {
@@ -211,13 +228,22 @@ proc is_config_true {name} {
}
}
+proc get_config {name} {
+ global repo_config
+ if {[catch {set v $repo_config($name)}]} {
+ return {}
+ } else {
+ return $v
+ }
+}
+
proc load_config {include_global} {
global repo_config global_config default_config
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]} {
@@ -233,7 +259,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]} {
@@ -260,8 +286,224 @@ 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 -
+ --version -
+ --exec-path { return [list $::_git $name] }
+ }
+
+ set p [gitexec git-$name$::_search_exe]
+ if {[file exists $p]} {
+ set v [list $p]
+ } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
+ # Try to determine what sort of magic will make
+ # git-$name go and do its thing, because native
+ # Tcl on Windows doesn't know it.
+ #
+ set p [gitexec git-$name]
+ set f [open $p r]
+ set s [gets $f]
+ close $f
+
+ switch -glob -- $s {
+ #!*sh { set i sh }
+ #!*perl { set i perl }
+ #!*python { set i python }
+ default { error "git-$name is not supported: $s" }
+ }
+
+ upvar #0 _$i interp
+ if {![info exists interp]} {
+ set interp [_which $i]
+ }
+ if {$interp eq {}} {
+ error "git-$name requires $i (not in PATH)"
+ }
+ set v [list $interp $p]
+ } else {
+ # Assume it is builtin to git somehow and we
+ # aren't actually able to see a file for it.
+ #
+ set v [list $::_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 _lappend_nice {cmd_var} {
+ global _nice
+ upvar $cmd_var cmd
+
+ if {![info exists _nice]} {
+ set _nice [_which nice]
+ }
+ if {$_nice ne {}} {
+ lappend cmd $_nice
+ }
+}
+
proc git {args} {
- return [eval exec git $args]
+ set opt [list exec]
+
+ while {1} {
+ switch -- [lindex $args 0] {
+ --nice {
+ _lappend_nice opt
+ }
+
+ 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 _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
+ }
+ }
+ fconfigure $fd -eofchar {}
+ return $fd
+}
+
+proc git_read {args} {
+ set opt [list |]
+
+ while {1} {
+ switch -- [lindex $args 0] {
+ --nice {
+ _lappend_nice opt
+ }
+
+ --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]
+
+ return [_open_stdout_stderr [concat $opt $cmdp $args]]
+}
+
+proc git_write {args} {
+ set opt [list |]
+
+ while {1} {
+ switch -- [lindex $args 0] {
+ --nice {
+ _lappend_nice opt
+ }
+
+ 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 sq {value} {
+ regsub -all ' $value "'\\''" value
+ return "'$value'"
+}
+
+proc load_current_branch {} {
+ global current_branch is_detached
+
+ set fd [open [gitdir HEAD] r]
+ if {[gets $fd ref] < 1} {
+ set ref {}
+ }
+ close $fd
+
+ set pfx {ref: refs/heads/}
+ set len [string length $pfx]
+ if {[string equal -length $len $pfx $ref]} {
+ # We're on a branch. It might not exist. But
+ # HEAD looks good enough to be a branch.
+ #
+ set current_branch [string range $ref $len end]
+ set is_detached 0
+ } else {
+ # Assume this is a detached head.
+ #
+ set current_branch HEAD
+ set is_detached 1
+ }
}
auto_load tk_optionMenu
@@ -275,35 +517,155 @@ proc tk_optionMenu {w varName args} {
######################################################################
##
-## version check
+## find git
-set req_maj 1
-set req_min 5
+set _git [_which git]
+if {$_git eq {}} {
+ catch {wm withdraw .}
+ error_popup "Cannot find git in PATH."
+ exit 1
+}
+
+######################################################################
+##
+## version check
-if {[catch {set v [git --version]} err]} {
+if {[catch {set _git_version [git --version]} err]} {
catch {wm withdraw .}
error_popup "Cannot determine Git version:
$err
-[appname] requires Git $req_maj.$req_min or later."
+[appname] requires Git 1.5.0 or later."
exit 1
}
-if {[regexp {^git version (\d+)\.(\d+)} $v _junk act_maj act_min]} {
- if {$act_maj < $req_maj
- || ($act_maj == $req_maj && $act_min < $req_min)} {
- catch {wm withdraw .}
- error_popup "[appname] requires Git $req_maj.$req_min or later.
+if {![regsub {^git version } $_git_version {} _git_version]} {
+ catch {wm withdraw .}
+ error_popup "Cannot parse Git version string:\n\n$_git_version"
+ exit 1
+}
+
+set _real_git_version $_git_version
+regsub -- {-dirty$} $_git_version {} _git_version
+regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
+regsub {\.rc[0-9]+$} $_git_version {} _git_version
+regsub {\.GIT$} $_git_version {} _git_version
-You are using $v."
+if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
+ catch {wm withdraw .}
+ if {[tk_messageBox \
+ -icon warning \
+ -type yesno \
+ -default no \
+ -title "[appname]: warning" \
+ -message "Git version cannot be determined.
+
+$_git claims it is version '$_real_git_version'.
+
+[appname] requires at least Git 1.5.0 or later.
+
+Assume '$_real_git_version' is version 1.5.0?
+"] eq {yes}} {
+ set _git_version 1.5.0
+ } else {
exit 1
}
-} else {
+}
+unset _real_git_version
+
+proc git-version {args} {
+ global _git_version
+
+ switch [llength $args] {
+ 0 {
+ return $_git_version
+ }
+
+ 2 {
+ set op [lindex $args 0]
+ set vr [lindex $args 1]
+ set cm [package vcompare $_git_version $vr]
+ return [expr $cm $op 0]
+ }
+
+ 4 {
+ set type [lindex $args 0]
+ set name [lindex $args 1]
+ set parm [lindex $args 2]
+ set body [lindex $args 3]
+
+ if {($type ne {proc} && $type ne {method})} {
+ error "Invalid arguments to git-version"
+ }
+ if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
+ error "Last arm of $type $name must be default"
+ }
+
+ foreach {op vr cb} [lrange $body 0 end-2] {
+ if {[git-version $op $vr]} {
+ return [uplevel [list $type $name $parm $cb]]
+ }
+ }
+
+ return [uplevel [list $type $name $parm [lindex $body end]]]
+ }
+
+ default {
+ error "git-version >= x"
+ }
+
+ }
+}
+
+if {[git-version < 1.5]} {
catch {wm withdraw .}
- error_popup "Cannot parse Git version string:\n\n$v"
+ error_popup "[appname] requires Git 1.5.0 or later.
+
+You are using [git-version]:
+
+[git --version]"
exit 1
}
-unset -nocomplain v _junk act_maj act_min req_maj req_min
+
+######################################################################
+##
+## feature option selection
+
+if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
+ unset _junk
+} else {
+ set subcommand gui
+}
+if {$subcommand eq {gui.sh}} {
+ set subcommand gui
+}
+if {$subcommand eq {gui} && [llength $argv] > 0} {
+ set subcommand [lindex $argv 0]
+ set argv [lrange $argv 1 end]
+}
+
+enable_option multicommit
+enable_option branch
+enable_option transport
+disable_option bare
+
+switch -- $subcommand {
+browser -
+blame {
+ enable_option bare
+
+ disable_option multicommit
+ disable_option branch
+ disable_option transport
+}
+citool {
+ enable_option singlecommit
+
+ disable_option multicommit
+ disable_option branch
+ disable_option transport
+}
+}
######################################################################
##
@@ -329,19 +691,24 @@ if {![file isdirectory $_gitdir]} {
error_popup "Git directory not found:\n\n$_gitdir"
exit 1
}
-if {[lindex [file split $_gitdir] end] ne {.git}} {
- catch {wm withdraw .}
- error_popup "Cannot use funny .git directory:\n\n$_gitdir"
- exit 1
+if {![is_enabled bare]} {
+ if {[lindex [file split $_gitdir] end] ne {.git}} {
+ catch {wm withdraw .}
+ error_popup "Cannot use funny .git directory:\n\n$_gitdir"
+ exit 1
+ }
+ if {[catch {cd [file dirname $_gitdir]} err]} {
+ catch {wm withdraw .}
+ error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
+ exit 1
+ }
}
-if {[catch {cd [file dirname $_gitdir]} err]} {
- catch {wm withdraw .}
- error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
- exit 1
+set _reponame [file split [file normalize $_gitdir]]
+if {[lindex $_reponame end] eq {.git}} {
+ set _reponame [lindex $_reponame end-1]
+} else {
+ set _reponame [lindex $_reponame end]
}
-set _reponame [lindex [file split \
- [file normalize [file dirname $_gitdir]]] \
- end]
######################################################################
##
@@ -350,7 +717,6 @@ set _reponame [lindex [file split \
set current_diff_path {}
set current_diff_side {}
set diff_actions [list]
-set ui_status_value {Initializing...}
set HEAD {}
set PARENT {}
@@ -358,6 +724,7 @@ set MERGE_HEAD [list]
set commit_type {}
set empty_tree {}
set current_branch {}
+set is_detached 0
set current_diff_path {}
set selected_commit_type new
@@ -407,15 +774,7 @@ proc repository_state {ctvar hdvar mhvar} {
set mh [list]
- if {[catch {set current_branch [git symbolic-ref HEAD]}]} {
- set current_branch {}
- } else {
- regsub ^refs/((heads|tags|remotes)/)? \
- $current_branch \
- {} \
- current_branch
- }
-
+ load_current_branch
if {[catch {set hd [git rev-parse --verify HEAD]}]} {
set hd {}
set ct initial
@@ -451,7 +810,7 @@ proc PARENT {} {
proc rescan {after {honor_trustmtime 1}} {
global HEAD PARENT MERGE_HEAD commit_type
- global ui_index ui_workdir ui_status_value ui_comm
+ global ui_index ui_workdir ui_comm
global rescan_active file_states
global repo_config
@@ -470,8 +829,9 @@ proc rescan {after {honor_trustmtime 1}} {
array unset file_states
- if {![$ui_comm edit modified]
- || [string trim [$ui_comm get 0.0 end]] eq {}} {
+ if {!$::GITGUI_BCK_exists &&
+ (![$ui_comm edit modified]
+ || [string trim [$ui_comm get 0.0 end]] eq {})} {
if {[string match amend* $commit_type]} {
} elseif {[load_message GITGUI_MSG]} {
} elseif {[load_message MERGE_MSG]} {
@@ -481,22 +841,17 @@ proc rescan {after {honor_trustmtime 1}} {
$ui_comm edit modified false
}
- if {[is_enabled branch]} {
- load_all_heads
- populate_branch_menu
- }
-
if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
rescan_stage2 {} $after
} else {
set rescan_active 1
- set ui_status_value {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]
+ ui_status {Refreshing file status...}
+ 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]
@@ -504,7 +859,6 @@ proc rescan {after {honor_trustmtime 1}} {
}
proc rescan_stage2 {fd after} {
- global ui_status_value
global rescan_active buf_rdi buf_rdf buf_rlo
if {$fd ne {}} {
@@ -513,22 +867,25 @@ 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"
}
+ set user_exclude [get_config core.excludesfile]
+ if {$user_exclude ne {} && [file readable $user_exclude]} {
+ lappend ls_others "--exclude-from=$user_exclude"
+ }
set buf_rdi {}
set buf_rdf {}
set buf_rlo {}
set rescan_active 3
- set ui_status_value {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]
+ ui_status {Scanning for modified files ...}
+ 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
@@ -546,6 +903,7 @@ proc load_message {file} {
if {[catch {set fd [open $f r]}]} {
return 0
}
+ fconfigure $fd -eofchar {}
set content [string trim [read $fd]]
close $fd
regsub -all -line {[ \r\t]+$} $content {} content
@@ -685,6 +1043,14 @@ proc mapdesc {state path} {
return $r
}
+proc ui_status {msg} {
+ $::main_status show $msg
+}
+
+proc ui_ready {{test {}}} {
+ $::main_status show {Ready.} $test
+}
+
proc escape_path {path} {
regsub -all {\\} $path "\\\\" path
regsub -all "\n" $path "\\n" path
@@ -930,32 +1296,6 @@ static unsigned char file_merge_bits[] = {
0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
} -maskdata $filemask
-set file_dir_data {
-#define file_width 18
-#define file_height 18
-static unsigned char file_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
- 0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
- 0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
- 0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
-}
-image create bitmap file_dir -background white -foreground blue \
- -data $file_dir_data -maskdata $file_dir_data
-unset file_dir_data
-
-set file_uplevel_data {
-#define up_width 15
-#define up_height 15
-static unsigned char up_bits[] = {
- 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
- 0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
- 0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
-}
-image create bitmap file_uplevel -background white -foreground red \
- -data $file_uplevel_data -maskdata $file_uplevel_data
-unset file_uplevel_data
-
set ui_index .vpane.files.index.list
set ui_workdir .vpane.files.workdir.list
@@ -1036,28 +1376,18 @@ proc incr_font_size {font {amt 1}} {
set starting_gitk_msg {Starting gitk... please wait...}
proc do_gitk {revs} {
- global env ui_status_value starting_gitk_msg
-
# -- Always start gitk through whatever we were loaded with. This
# lets us bypass using shell process on Windows systems.
#
- set cmd [list [info nameofexecutable]]
- set exe [gitexec gitk]
- lappend cmd $exe
- if {$revs ne {}} {
- append cmd { }
- append cmd $revs
- }
-
+ set exe [file join [file dirname $::_git] gitk]
+ set cmd [list [info nameofexecutable] $exe]
if {! [file exists $exe]} {
error_popup "Unable to start gitk:\n\n$exe does not exist"
} else {
- eval exec $cmd &
- set ui_status_value $starting_gitk_msg
+ eval exec $cmd $revs &
+ ui_status $::starting_gitk_msg
after 10000 {
- if {$ui_status_value eq $starting_gitk_msg} {
- set ui_status_value {Ready.}
- }
+ ui_ready $starting_gitk_msg
}
}
}
@@ -1066,6 +1396,7 @@ set is_quitting 0
proc do_quit {} {
global ui_comm is_quitting repo_config commit_type
+ global GITGUI_BCK_exists GITGUI_BCK_i
if {$is_quitting} return
set is_quitting 1
@@ -1074,18 +1405,30 @@ proc do_quit {} {
# -- Stash our current commit buffer.
#
set save [gitdir GITGUI_MSG]
- set msg [string trim [$ui_comm get 0.0 end]]
- regsub -all -line {[ \r\t]+$} $msg {} msg
- if {(![string match amend* $commit_type]
- || [$ui_comm edit modified])
- && $msg ne {}} {
- catch {
- set fd [open $save w]
- puts -nonewline $fd $msg
- close $fd
- }
+ if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
+ file rename -force [gitdir GITGUI_BCK] $save
+ set GITGUI_BCK_exists 0
} else {
- catch {file delete $save}
+ set msg [string trim [$ui_comm get 0.0 end]]
+ regsub -all -line {[ \r\t]+$} $msg {} msg
+ if {(![string match amend* $commit_type]
+ || [$ui_comm edit modified])
+ && $msg ne {}} {
+ catch {
+ set fd [open $save w]
+ puts -nonewline $fd $msg
+ close $fd
+ }
+ } else {
+ catch {file delete $save}
+ }
+ }
+
+ # -- Remove our editor backup, its not needed.
+ #
+ after cancel $GITGUI_BCK_i
+ if {$GITGUI_BCK_exists} {
+ catch {file delete [gitdir GITGUI_BCK]}
}
# -- Stash our current window geometry into this repository.
@@ -1106,7 +1449,7 @@ proc do_quit {} {
}
proc do_rescan {} {
- rescan {set ui_status_value {Ready.}}
+ rescan ui_ready
}
proc do_commit {} {
@@ -1141,12 +1484,12 @@ proc toggle_or_diff {w x y} {
update_indexinfo \
"Unstaging [short_path $path] from commit" \
[list $path] \
- [concat $after {set ui_status_value {Ready.}}]
+ [concat $after [list ui_ready]]
} elseif {$w eq $ui_workdir} {
update_index \
"Adding [short_path $path]" \
[list $path] \
- [concat $after {set ui_status_value {Ready.}}]
+ [concat $after [list ui_ready]]
}
} else {
show_diff $path $w $lno
@@ -1233,6 +1576,10 @@ foreach class {Button Checkbutton Entry Label
}
unset class
+if {[is_Windows] || [is_MacOSX]} {
+ option add *Menu.tearOff 0
+}
+
if {[is_MacOSX]} {
set M1B M1
set M1T Cmd
@@ -1263,11 +1610,14 @@ proc apply_config {} {
}
}
+set default_config(merge.diffstat) true
set default_config(merge.summary) false
set default_config(merge.verbosity) 2
set default_config(user.name) {}
set default_config(user.email) {}
+set default_config(gui.matchtrackingbranch) false
+set default_config(gui.pruneduringfetch) false
set default_config(gui.trustmtime) false
set default_config(gui.diffcontext) 5
set default_config(gui.newbranchtemplate) {}
@@ -1282,43 +1632,6 @@ apply_config
######################################################################
##
-## feature option selection
-
-if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
- unset _junk
-} else {
- set subcommand gui
-}
-if {$subcommand eq {gui.sh}} {
- set subcommand gui
-}
-if {$subcommand eq {gui} && [llength $argv] > 0} {
- set subcommand [lindex $argv 0]
- set argv [lrange $argv 1 end]
-}
-
-enable_option multicommit
-enable_option branch
-enable_option transport
-
-switch -- $subcommand {
-browser -
-blame {
- disable_option multicommit
- disable_option branch
- disable_option transport
-}
-citool {
- enable_option singlecommit
-
- disable_option multicommit
- disable_option branch
- disable_option transport
-}
-}
-
-######################################################################
-##
## ui construction
set ui_comm {}
@@ -1346,20 +1659,32 @@ if {[is_enabled transport]} {
menu .mbar.repository
.mbar.repository add command \
- -label {Browse Current Branch} \
+ -label {Browse Current Branch's Files} \
-command {browser::new $current_branch}
-trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
+set ui_browse_current [.mbar.repository index last]
+.mbar.repository add command \
+ -label {Browse Branch Files...} \
+ -command browser_open::dialog
.mbar.repository add separator
.mbar.repository add command \
- -label {Visualize Current Branch} \
+ -label {Visualize Current Branch's History} \
-command {do_gitk $current_branch}
-trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
+set ui_visualize_current [.mbar.repository index last]
.mbar.repository add command \
- -label {Visualize All Branches} \
+ -label {Visualize All Branch History} \
-command {do_gitk --all}
.mbar.repository add separator
+proc current_branch_write {args} {
+ global current_branch
+ .mbar.repository entryconf $::ui_browse_current \
+ -label "Browse $current_branch's Files"
+ .mbar.repository entryconf $::ui_visualize_current \
+ -label "Visualize $current_branch's History"
+}
+trace add variable current_branch write current_branch_write
+
if {[is_enabled multicommit]} {
.mbar.repository add command -label {Database Statistics} \
-command do_stats
@@ -1424,13 +1749,24 @@ if {[is_enabled branch]} {
menu .mbar.branch
.mbar.branch add command -label {Create...} \
- -command do_create_branch \
+ -command branch_create::dialog \
-accelerator $M1T-N
lappend disable_on_lock [list .mbar.branch entryconf \
[.mbar.branch index last] -state]
+ .mbar.branch add command -label {Checkout...} \
+ -command branch_checkout::dialog \
+ -accelerator $M1T-O
+ lappend disable_on_lock [list .mbar.branch entryconf \
+ [.mbar.branch index last] -state]
+
+ .mbar.branch add command -label {Rename...} \
+ -command branch_rename::dialog
+ lappend disable_on_lock [list .mbar.branch entryconf \
+ [.mbar.branch index last] -state]
+
.mbar.branch add command -label {Delete...} \
- -command do_delete_branch
+ -command branch_delete::dialog
lappend disable_on_lock [list .mbar.branch entryconf \
[.mbar.branch index last] -state]
@@ -1469,12 +1805,12 @@ if {[is_enabled multicommit] || [is_enabled singlecommit]} {
lappend disable_on_lock \
[list .mbar.commit entryconf [.mbar.commit index last] -state]
- .mbar.commit add command -label {Add To Commit} \
+ .mbar.commit add command -label {Stage To Commit} \
-command do_add_selection
lappend disable_on_lock \
[list .mbar.commit entryconf [.mbar.commit index last] -state]
- .mbar.commit add command -label {Add Existing To Commit} \
+ .mbar.commit add command -label {Stage Changed Files To Commit} \
-command do_add_all \
-accelerator $M1T-I
lappend disable_on_lock \
@@ -1508,14 +1844,14 @@ if {[is_enabled multicommit] || [is_enabled singlecommit]} {
if {[is_enabled branch]} {
menu .mbar.merge
.mbar.merge add command -label {Local Merge...} \
- -command merge::dialog
+ -command merge::dialog \
+ -accelerator $M1T-M
lappend disable_on_lock \
[list .mbar.merge entryconf [.mbar.merge index last] -state]
.mbar.merge add command -label {Abort Merge...} \
-command merge::reset_hard
lappend disable_on_lock \
[list .mbar.merge entryconf [.mbar.merge index last] -state]
-
}
# -- Transport Menu
@@ -1527,6 +1863,8 @@ if {[is_enabled transport]} {
.mbar.push add command -label {Push...} \
-command do_push_anywhere \
-accelerator $M1T-P
+ .mbar.push add command -label {Delete...} \
+ -command remote_branch_delete::dialog
}
if {[is_MacOSX]} {
@@ -1545,34 +1883,6 @@ if {[is_MacOSX]} {
.mbar.edit add separator
.mbar.edit add command -label {Options...} \
-command do_options
-
- # -- Tools Menu
- #
- if {[is_Cygwin] && [file exists /usr/local/miga/lib/gui-miga]} {
- proc do_miga {} {
- global ui_status_value
- if {![lock_index update]} return
- set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
- set miga_fd [open "|$cmd" r]
- fconfigure $miga_fd -blocking 0
- fileevent $miga_fd readable [list miga_done $miga_fd]
- set ui_status_value {Running miga...}
- }
- proc miga_done {fd} {
- read $fd 512
- if {[eof $fd]} {
- close $fd
- unlock_index
- rescan [list set ui_status_value {Ready.}]
- }
- }
- .mbar add cascade -label Tools -menu .mbar.tools
- menu .mbar.tools
- .mbar.tools add command -label "Migrate" \
- -command do_miga
- lappend disable_on_lock \
- [list .mbar.tools entryconf [.mbar.tools index last] -state]
- }
}
# -- Help Menu
@@ -1640,24 +1950,10 @@ proc usage {} {
# -- Not a normal commit type invocation? Do that instead!
#
switch -- $subcommand {
-browser {
- set subcommand_args {rev?}
- switch [llength $argv] {
- 0 {
- set current_branch [git symbolic-ref HEAD]
- regsub ^refs/((heads|tags|remotes)/)? \
- $current_branch {} current_branch
- }
- 1 {
- set current_branch [lindex $argv 0]
- }
- default usage
- }
- browser::new $current_branch
- return
-}
+browser -
blame {
- set subcommand_args {rev? path?}
+ set subcommand_args {rev? path}
+ if {$argv eq {}} usage
set head {}
set path {}
set is_path 0
@@ -1676,22 +1972,52 @@ blame {
} elseif {$head eq {}} {
if {$head ne {}} usage
set head $a
+ set is_path 1
} else {
usage
}
}
unset is_path
+ if {$head ne {} && $path eq {}} {
+ set path $_prefix$head
+ set head {}
+ }
+
if {$head eq {}} {
- set current_branch [git symbolic-ref HEAD]
- regsub ^refs/((heads|tags|remotes)/)? \
- $current_branch {} current_branch
+ load_current_branch
} else {
+ if {[regexp {^[0-9a-f]{1,39}$} $head]} {
+ if {[catch {
+ set head [git rev-parse --verify $head]
+ } err]} {
+ puts stderr $err
+ exit 1
+ }
+ }
set current_branch $head
}
- if {$path eq {}} usage
- blame::new $head $path
+ switch -- $subcommand {
+ browser {
+ if {$head eq {}} {
+ if {$path ne {} && [file isdirectory $path]} {
+ set head $current_branch
+ } else {
+ set head $path
+ set path {}
+ }
+ }
+ browser::new $head $path
+ }
+ blame {
+ if {$head eq {} && ![file exists $path]} {
+ puts stderr "fatal: cannot stat path $path: No such file or directory"
+ exit 1
+ }
+ blame::new $head $path
+ }
+ }
return
}
citool -
@@ -1806,7 +2132,7 @@ pack .vpane.lower.commarea.buttons.rescan -side top -fill x
lappend disable_on_lock \
{.vpane.lower.commarea.buttons.rescan conf -state}
-button .vpane.lower.commarea.buttons.incall -text {Add Existing} \
+button .vpane.lower.commarea.buttons.incall -text {Stage Changed} \
-command do_add_all
pack .vpane.lower.commarea.buttons.incall -side top -fill x
lappend disable_on_lock \
@@ -2080,26 +2406,31 @@ lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add separator
$ctxm add command -label {Options...} \
-command do_options
-bind_button3 $ui_diff "
- set cursorX %x
- set cursorY %y
- if {\$ui_index eq \$current_diff_side} {
- $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
+proc popup_diff_menu {ctxm x y X Y} {
+ set ::cursorX $x
+ set ::cursorY $y
+ if {$::ui_index eq $::current_diff_side} {
+ $ctxm entryconf $::ui_diff_applyhunk \
+ -state normal \
+ -label {Unstage Hunk From Commit}
+ } elseif {{_O} eq [lindex $::file_states($::current_diff_path) 0]} {
+ $ctxm entryconf $::ui_diff_applyhunk \
+ -state disabled \
+ -label {Stage Hunk For Commit}
} else {
- $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
+ $ctxm entryconf $::ui_diff_applyhunk \
+ -state normal \
+ -label {Stage Hunk For Commit}
}
- tk_popup $ctxm %X %Y
-"
-unset ui_diff_applyhunk
+ tk_popup $ctxm $X $Y
+}
+bind_button3 $ui_diff [list popup_diff_menu $ctxm %x %y %X %Y]
# -- Status Bar
#
-label .status -textvariable ui_status_value \
- -anchor w \
- -justify left \
- -borderwidth 1 \
- -relief sunken
+set main_status [::status_bar::new .status]
pack .status -anchor w -side bottom -fill x
+$main_status show {Initializing...}
# -- Load geometry
#
@@ -2150,8 +2481,12 @@ bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
bind $ui_diff <Button-1> {focus %W}
if {[is_enabled branch]} {
- bind . <$M1B-Key-n> do_create_branch
- bind . <$M1B-Key-N> do_create_branch
+ bind . <$M1B-Key-n> branch_create::dialog
+ bind . <$M1B-Key-N> branch_create::dialog
+ bind . <$M1B-Key-o> branch_checkout::dialog
+ bind . <$M1B-Key-O> branch_checkout::dialog
+ bind . <$M1B-Key-m> merge::dialog
+ bind . <$M1B-Key-M> merge::dialog
}
if {[is_enabled transport]} {
bind . <$M1B-Key-p> do_push_anywhere
@@ -2238,31 +2573,69 @@ user.email settings into your personal
#
if {[is_enabled transport]} {
load_all_remotes
- load_all_heads
- populate_branch_menu
populate_fetch_menu
populate_push_menu
}
-# -- Only suggest a gc run if we are going to stay running.
-#
-if {[is_enabled multicommit]} {
- set object_limit 2000
- if {[is_Windows]} {set object_limit 200}
- regexp {^([0-9]+) objects,} [git count-objects] _junk objects_current
- if {$objects_current >= $object_limit} {
- if {[ask_popup \
- "This repository currently has $objects_current loose objects.
+if {[winfo exists $ui_comm]} {
+ set GITGUI_BCK_exists [load_message GITGUI_BCK]
+
+ # -- If both our backup and message files exist use the
+ # newer of the two files to initialize the buffer.
+ #
+ if {$GITGUI_BCK_exists} {
+ set m [gitdir GITGUI_MSG]
+ if {[file isfile $m]} {
+ if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
+ catch {file delete [gitdir GITGUI_MSG]}
+ } else {
+ $ui_comm delete 0.0 end
+ $ui_comm edit reset
+ $ui_comm edit modified false
+ catch {file delete [gitdir GITGUI_BCK]}
+ set GITGUI_BCK_exists 0
+ }
+ }
+ unset m
+ }
-To maintain optimal performance it is strongly recommended that you compress the database when more than $object_limit loose objects exist.
+ proc backup_commit_buffer {} {
+ global ui_comm GITGUI_BCK_exists
-Compress the database now?"] eq yes} {
- do_gc
+ set m [$ui_comm edit modified]
+ if {$m || $GITGUI_BCK_exists} {
+ set msg [string trim [$ui_comm get 0.0 end]]
+ regsub -all -line {[ \r\t]+$} $msg {} msg
+
+ if {$msg eq {}} {
+ if {$GITGUI_BCK_exists} {
+ catch {file delete [gitdir GITGUI_BCK]}
+ set GITGUI_BCK_exists 0
+ }
+ } elseif {$m} {
+ catch {
+ set fd [open [gitdir GITGUI_BCK] w]
+ puts -nonewline $fd $msg
+ close $fd
+ set GITGUI_BCK_exists 1
+ }
+ }
+
+ $ui_comm edit modified false
}
+
+ set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
}
- unset object_limit _junk objects_current
+
+ backup_commit_buffer
}
lock_index begin-read
+if {![winfo ismapped .]} {
+ wm deiconify .
+}
after 1 do_rescan
+if {[is_enabled multicommit]} {
+ after 1000 hint_gc
+}
diff --git a/git-gui/lib/blame.tcl b/git-gui/lib/blame.tcl
index 1d2caac..9607284 100644
--- a/git-gui/lib/blame.tcl
+++ b/git-gui/lib/blame.tcl
@@ -21,7 +21,7 @@ field w_amov ; # text column: annotations + move tracking
field w_asim ; # text column: annotations (simple computation)
field w_file ; # text column: actual file data
field w_cviewer ; # pane showing commit message
-field status ; # text variable bound to status bar
+field status ; # status mega-widget instance
field old_height ; # last known height of $w.file_pane
# Tk UI colors
@@ -33,6 +33,13 @@ variable group_colors {
#ececec
}
+# Switches for original location detection
+#
+variable original_options [list -C -C]
+if {[git-version >= 1.5.3]} {
+ lappend original_options -w ; # ignore indentation changes
+}
+
# Current blame data; cleared/reset on each load
#
field commit ; # input commit to blame
@@ -235,14 +242,7 @@ constructor new {i_commit i_path} {
pack $w.file_pane.cm.sbx -side bottom -fill x
pack $w_cviewer -expand 1 -fill both
- frame $w.status \
- -borderwidth 1 \
- -relief sunken
- label $w.status.l \
- -textvariable @status \
- -anchor w \
- -justify left
- pack $w.status.l -side left
+ set status [::status_bar::new $w.status]
menu $w.ctxm -tearoff 0
$w.ctxm add command \
@@ -304,8 +304,9 @@ constructor new {i_commit i_path} {
set req_w [winfo reqwidth $top]
set req_h [winfo reqheight $top]
+ set scr_h [expr {[winfo screenheight $top] - 100}]
if {$req_w < 600} {set req_w 600}
- if {$req_h < 400} {set req_h 400}
+ if {$req_h < $scr_h} {set req_h $scr_h}
set g "${req_w}x${req_h}"
wm geometry $top $g
update
@@ -352,19 +353,6 @@ method _load {jump} {
set total_lines 0
}
- if {[winfo exists $w.status.c]} {
- $w.status.c coords bar 0 0 0 20
- } else {
- canvas $w.status.c \
- -width 100 \
- -height [expr {int([winfo reqheight $w.status.l] * 0.6)}] \
- -borderwidth 1 \
- -relief groove \
- -highlightt 0
- $w.status.c create rectangle 0 0 0 20 -tags bar -fill navy
- pack $w.status.c -side right
- }
-
if {$history eq {}} {
$w_back conf -state disabled
} else {
@@ -378,13 +366,13 @@ method _load {jump} {
set amov_data [list [list]]
set asim_data [list [list]]
- set status "Loading $commit:[escape_path $path]..."
+ $status show "Reading $commit:[escape_path $path]..."
$w_path conf -text [escape_path $path]
if {$commit eq {}} {
set fd [open $path r]
+ fconfigure $fd -eofchar {}
} 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]
@@ -487,30 +475,28 @@ 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 $cur_s]
+ fileevent $fd readable [cb _read_blame $fd $cur_w $cur_d]
set current_fd $fd
set blame_lines 0
- _status $this $cur_s
+
+ $status start \
+ "Loading$cur_s annotations..." \
+ {lines annotated}
}
-method _read_blame {fd cur_w cur_d cur_s} {
+method _read_blame {fd cur_w cur_d} {
upvar #0 $cur_d line_data
variable group_colors
+ variable original_options
if {$fd ne $current_fd} {
catch {close $fd}
@@ -684,30 +670,17 @@ method _read_blame {fd cur_w cur_d cur_s} {
close $fd
if {$cur_w eq $w_asim} {
_exec_blame $this $w_amov @amov_data \
- [list -M -C -C] \
+ $original_options \
{ original location}
} else {
set current_fd {}
- set status {Annotation complete.}
- destroy $w.status.c
+ $status stop {Annotation complete.}
}
} else {
- _status $this $cur_s
+ $status update $blame_lines $total_lines
}
} ifdeleted { catch {close $fd} }
-method _status {cur_s} {
- set have $blame_lines
- set total $total_lines
- set pdone 0
- if {$total} {set pdone [expr {100 * $have / $total}]}
-
- set status [format \
- "Loading%s annotations... %i of %i lines annotated (%2i%%)" \
- $cur_s $have $total $pdone]
- $w.status.c coords bar 0 0 $pdone 20
-}
-
method _click {cur_w pos} {
set lno [lindex [split [$cur_w index $pos] .] 0]
_showcommit $this $cur_w $lno
@@ -788,7 +761,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
@@ -798,15 +771,20 @@ method _showcommit {cur_w lno} {
set enc [string tolower [string range $line 9 end]]
}
}
- set msg [encoding convertfrom $enc [read $fd]]
- set msg [string trim $msg]
+ set msg [read $fd]
close $fd
- set author_name [encoding convertfrom $enc $author_name]
- set committer_name [encoding convertfrom $enc $committer_name]
-
- set header($cmit,author) $author_name
- set header($cmit,committer) $committer_name
+ set enc [tcl_encoding $enc]
+ if {$enc ne {}} {
+ set msg [encoding convertfrom $enc $msg]
+ set author_name [encoding convertfrom $enc $author_name]
+ set committer_name [encoding convertfrom $enc $committer_name]
+ set header($cmit,author) $author_name
+ set header($cmit,committer) $committer_name
+ set header($cmit,summary) \
+ [encoding convertfrom $enc $header($cmit,summary)]
+ }
+ set msg [string trim $msg]
}
set header($cmit,message) $msg
}
@@ -901,6 +879,11 @@ method _open_tooltip {cur_w} {
set org [lindex $amov_data $lno]
}
+ if {$dat eq {}} {
+ _hide_tooltip $this
+ return
+ }
+
set cmit [lindex $dat 0]
set tooltip_commit [list $cmit]
diff --git a/git-gui/lib/branch.tcl b/git-gui/lib/branch.tcl
index 4f648b2..777eeb7 100644
--- a/git-gui/lib/branch.tcl
+++ b/git-gui/lib/branch.tcl
@@ -2,573 +2,37 @@
# Copyright (C) 2006, 2007 Shawn Pearce
proc load_all_heads {} {
- global all_heads
+ global some_heads_tracking
+ 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) refs/heads" r]
+ set fd [git_read for-each-ref --format=%(refname) $rh]
while {[gets $fd line] > 0} {
- if {[is_tracking_branch $line]} continue
- if {![regsub ^refs/heads/ $line {} name]} continue
- lappend all_heads $name
+ if {!$some_heads_tracking || ![is_tracking_branch $line]} {
+ lappend all_heads [string range $line $rh_len end]
+ }
}
close $fd
- set all_heads [lsort $all_heads]
+ return [lsort $all_heads]
}
proc load_all_tags {} {
set all_tags [list]
- set fd [open "| git for-each-ref --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
}
close $fd
-
- return [lsort $all_tags]
-}
-
-proc populate_branch_menu {} {
- global all_heads disable_on_lock
-
- set m .mbar.branch
- set last [$m index last]
- for {set i 0} {$i <= $last} {incr i} {
- if {[$m type $i] eq {separator}} {
- $m delete $i last
- set new_dol [list]
- foreach a $disable_on_lock {
- if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
- lappend new_dol $a
- }
- }
- set disable_on_lock $new_dol
- break
- }
- }
-
- if {$all_heads ne {}} {
- $m add separator
- }
- foreach b $all_heads {
- $m add radiobutton \
- -label $b \
- -command [list switch_branch $b] \
- -variable current_branch \
- -value $b
- lappend disable_on_lock \
- [list $m entryconf [$m index last] -state]
- }
-}
-
-proc do_create_branch_action {w} {
- global all_heads null_sha1 repo_config
- global create_branch_checkout create_branch_revtype
- global create_branch_head create_branch_trackinghead
- global create_branch_name create_branch_revexp
- global create_branch_tag
-
- set newbranch $create_branch_name
- if {$newbranch eq {}
- || $newbranch eq $repo_config(gui.newbranchtemplate)} {
- tk_messageBox \
- -icon error \
- -type ok \
- -title [wm title $w] \
- -parent $w \
- -message "Please supply a branch name."
- focus $w.desc.name_t
- return
- }
- if {![catch {git show-ref --verify -- "refs/heads/$newbranch"}]} {
- tk_messageBox \
- -icon error \
- -type ok \
- -title [wm title $w] \
- -parent $w \
- -message "Branch '$newbranch' already exists."
- focus $w.desc.name_t
- return
- }
- if {[catch {git check-ref-format "heads/$newbranch"}]} {
- tk_messageBox \
- -icon error \
- -type ok \
- -title [wm title $w] \
- -parent $w \
- -message "We do not like '$newbranch' as a branch name."
- focus $w.desc.name_t
- return
- }
-
- set rev {}
- switch -- $create_branch_revtype {
- head {set rev $create_branch_head}
- tracking {set rev $create_branch_trackinghead}
- tag {set rev $create_branch_tag}
- expression {set rev $create_branch_revexp}
- }
- if {[catch {set cmt [git rev-parse --verify "${rev}^0"]}]} {
- tk_messageBox \
- -icon error \
- -type ok \
- -title [wm title $w] \
- -parent $w \
- -message "Invalid starting revision: $rev"
- return
- }
- if {[catch {
- git update-ref \
- -m "branch: Created from $rev" \
- "refs/heads/$newbranch" \
- $cmt \
- $null_sha1
- } err]} {
- tk_messageBox \
- -icon error \
- -type ok \
- -title [wm title $w] \
- -parent $w \
- -message "Failed to create '$newbranch'.\n\n$err"
- return
- }
-
- lappend all_heads $newbranch
- set all_heads [lsort $all_heads]
- populate_branch_menu
- destroy $w
- if {$create_branch_checkout} {
- switch_branch $newbranch
- }
+ return $all_tags
}
proc radio_selector {varname value args} {
upvar #0 $varname var
set var $value
}
-
-trace add variable create_branch_head write \
- [list radio_selector create_branch_revtype head]
-trace add variable create_branch_trackinghead write \
- [list radio_selector create_branch_revtype tracking]
-trace add variable create_branch_tag write \
- [list radio_selector create_branch_revtype tag]
-
-trace add variable delete_branch_head write \
- [list radio_selector delete_branch_checktype head]
-trace add variable delete_branch_trackinghead write \
- [list radio_selector delete_branch_checktype tracking]
-
-proc do_create_branch {} {
- global all_heads current_branch repo_config
- global create_branch_checkout create_branch_revtype
- global create_branch_head create_branch_trackinghead
- global create_branch_name create_branch_revexp
- global create_branch_tag
-
- set w .branch_editor
- toplevel $w
- wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
-
- label $w.header -text {Create New Branch} \
- -font font_uibold
- pack $w.header -side top -fill x
-
- frame $w.buttons
- button $w.buttons.create -text Create \
- -default active \
- -command [list do_create_branch_action $w]
- pack $w.buttons.create -side right
- button $w.buttons.cancel -text {Cancel} \
- -command [list destroy $w]
- pack $w.buttons.cancel -side right -padx 5
- pack $w.buttons -side bottom -fill x -pady 10 -padx 10
-
- labelframe $w.desc -text {Branch Description}
- label $w.desc.name_l -text {Name:}
- entry $w.desc.name_t \
- -borderwidth 1 \
- -relief sunken \
- -width 40 \
- -textvariable create_branch_name \
- -validate key \
- -validatecommand {
- if {%d == 1 && [regexp {[~^:?*\[\0- ]} %S]} {return 0}
- return 1
- }
- grid $w.desc.name_l $w.desc.name_t -sticky we -padx {0 5}
- grid columnconfigure $w.desc 1 -weight 1
- pack $w.desc -anchor nw -fill x -pady 5 -padx 5
-
- labelframe $w.from -text {Starting Revision}
- if {$all_heads ne {}} {
- radiobutton $w.from.head_r \
- -text {Local Branch:} \
- -value head \
- -variable create_branch_revtype
- eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
- grid $w.from.head_r $w.from.head_m -sticky w
- }
- set all_trackings [all_tracking_branches]
- if {$all_trackings ne {}} {
- set create_branch_trackinghead [lindex $all_trackings 0]
- radiobutton $w.from.tracking_r \
- -text {Tracking Branch:} \
- -value tracking \
- -variable create_branch_revtype
- eval tk_optionMenu $w.from.tracking_m \
- create_branch_trackinghead \
- $all_trackings
- grid $w.from.tracking_r $w.from.tracking_m -sticky w
- }
- set all_tags [load_all_tags]
- if {$all_tags ne {}} {
- set create_branch_tag [lindex $all_tags 0]
- radiobutton $w.from.tag_r \
- -text {Tag:} \
- -value tag \
- -variable create_branch_revtype
- eval tk_optionMenu $w.from.tag_m create_branch_tag $all_tags
- grid $w.from.tag_r $w.from.tag_m -sticky w
- }
- radiobutton $w.from.exp_r \
- -text {Revision Expression:} \
- -value expression \
- -variable create_branch_revtype
- entry $w.from.exp_t \
- -borderwidth 1 \
- -relief sunken \
- -width 50 \
- -textvariable create_branch_revexp \
- -validate key \
- -validatecommand {
- if {%d == 1 && [regexp {\s} %S]} {return 0}
- if {%d == 1 && [string length %S] > 0} {
- set create_branch_revtype expression
- }
- return 1
- }
- grid $w.from.exp_r $w.from.exp_t -sticky we -padx {0 5}
- grid columnconfigure $w.from 1 -weight 1
- pack $w.from -anchor nw -fill x -pady 5 -padx 5
-
- labelframe $w.postActions -text {Post Creation Actions}
- checkbutton $w.postActions.checkout \
- -text {Checkout after creation} \
- -variable create_branch_checkout
- pack $w.postActions.checkout -anchor nw
- pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
-
- set create_branch_checkout 1
- set create_branch_head $current_branch
- set create_branch_revtype head
- set create_branch_name $repo_config(gui.newbranchtemplate)
- set create_branch_revexp {}
-
- bind $w <Visibility> "
- grab $w
- $w.desc.name_t icursor end
- focus $w.desc.name_t
- "
- bind $w <Key-Escape> "destroy $w"
- bind $w <Key-Return> "do_create_branch_action $w;break"
- wm title $w "[appname] ([reponame]): Create Branch"
- tkwait window $w
-}
-
-proc do_delete_branch_action {w} {
- global all_heads
- global delete_branch_checktype delete_branch_head delete_branch_trackinghead
-
- set check_rev {}
- switch -- $delete_branch_checktype {
- head {set check_rev $delete_branch_head}
- tracking {set check_rev $delete_branch_trackinghead}
- always {set check_rev {:none}}
- }
- if {$check_rev eq {:none}} {
- set check_cmt {}
- } elseif {[catch {set check_cmt [git rev-parse --verify "${check_rev}^0"]}]} {
- tk_messageBox \
- -icon error \
- -type ok \
- -title [wm title $w] \
- -parent $w \
- -message "Invalid check revision: $check_rev"
- return
- }
-
- set to_delete [list]
- set not_merged [list]
- foreach i [$w.list.l curselection] {
- set b [$w.list.l get $i]
- if {[catch {set o [git rev-parse --verify $b]}]} continue
- if {$check_cmt ne {}} {
- if {$b eq $check_rev} continue
- if {[catch {set m [git merge-base $o $check_cmt]}]} continue
- if {$o ne $m} {
- lappend not_merged $b
- continue
- }
- }
- lappend to_delete [list $b $o]
- }
- if {$not_merged ne {}} {
- set msg "The following branches are not completely merged into $check_rev:
-
- - [join $not_merged "\n - "]"
- tk_messageBox \
- -icon info \
- -type ok \
- -title [wm title $w] \
- -parent $w \
- -message $msg
- }
- if {$to_delete eq {}} return
- if {$delete_branch_checktype eq {always}} {
- set msg {Recovering deleted branches is difficult.
-
-Delete the selected branches?}
- if {[tk_messageBox \
- -icon warning \
- -type yesno \
- -title [wm title $w] \
- -parent $w \
- -message $msg] ne yes} {
- return
- }
- }
-
- set failed {}
- foreach i $to_delete {
- set b [lindex $i 0]
- set o [lindex $i 1]
- if {[catch {git update-ref -d "refs/heads/$b" $o} err]} {
- append failed " - $b: $err\n"
- } else {
- set x [lsearch -sorted -exact $all_heads $b]
- if {$x >= 0} {
- set all_heads [lreplace $all_heads $x $x]
- }
- }
- }
-
- if {$failed ne {}} {
- tk_messageBox \
- -icon error \
- -type ok \
- -title [wm title $w] \
- -parent $w \
- -message "Failed to delete branches:\n$failed"
- }
-
- set all_heads [lsort $all_heads]
- populate_branch_menu
- destroy $w
-}
-
-proc do_delete_branch {} {
- global all_heads tracking_branches current_branch
- global delete_branch_checktype delete_branch_head delete_branch_trackinghead
-
- set w .branch_editor
- toplevel $w
- wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
-
- label $w.header -text {Delete Local Branch} \
- -font font_uibold
- pack $w.header -side top -fill x
-
- frame $w.buttons
- button $w.buttons.create -text Delete \
- -command [list do_delete_branch_action $w]
- pack $w.buttons.create -side right
- button $w.buttons.cancel -text {Cancel} \
- -command [list destroy $w]
- pack $w.buttons.cancel -side right -padx 5
- pack $w.buttons -side bottom -fill x -pady 10 -padx 10
-
- labelframe $w.list -text {Local Branches}
- listbox $w.list.l \
- -height 10 \
- -width 70 \
- -selectmode extended \
- -yscrollcommand [list $w.list.sby set]
- foreach h $all_heads {
- if {$h ne $current_branch} {
- $w.list.l insert end $h
- }
- }
- scrollbar $w.list.sby -command [list $w.list.l yview]
- pack $w.list.sby -side right -fill y
- pack $w.list.l -side left -fill both -expand 1
- pack $w.list -fill both -expand 1 -pady 5 -padx 5
-
- labelframe $w.validate -text {Delete Only If}
- radiobutton $w.validate.head_r \
- -text {Merged Into Local Branch:} \
- -value head \
- -variable delete_branch_checktype
- eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
- grid $w.validate.head_r $w.validate.head_m -sticky w
- set all_trackings [all_tracking_branches]
- if {$all_trackings ne {}} {
- set delete_branch_trackinghead [lindex $all_trackings 0]
- radiobutton $w.validate.tracking_r \
- -text {Merged Into Tracking Branch:} \
- -value tracking \
- -variable delete_branch_checktype
- eval tk_optionMenu $w.validate.tracking_m \
- delete_branch_trackinghead \
- $all_trackings
- grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
- }
- radiobutton $w.validate.always_r \
- -text {Always (Do not perform merge checks)} \
- -value always \
- -variable delete_branch_checktype
- grid $w.validate.always_r -columnspan 2 -sticky w
- grid columnconfigure $w.validate 1 -weight 1
- pack $w.validate -anchor nw -fill x -pady 5 -padx 5
-
- set delete_branch_head $current_branch
- set delete_branch_checktype head
-
- bind $w <Visibility> "grab $w; focus $w"
- bind $w <Key-Escape> "destroy $w"
- wm title $w "[appname] ([reponame]): Delete Branch"
- tkwait window $w
-}
-
-proc switch_branch {new_branch} {
- global HEAD commit_type current_branch repo_config
-
- if {![lock_index switch]} return
-
- # -- Our in memory state should match the repository.
- #
- repository_state curType curHEAD curMERGE_HEAD
- if {[string match amend* $commit_type]
- && $curType eq {normal}
- && $curHEAD eq $HEAD} {
- } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
- info_popup {Last scanned state does not match repository state.
-
-Another Git program has modified this repository since the last scan. A rescan must be performed before the current branch can be changed.
-
-The rescan will be automatically started now.
-}
- unlock_index
- rescan {set ui_status_value {Ready.}}
- return
- }
-
- # -- Don't do a pointless switch.
- #
- if {$current_branch eq $new_branch} {
- unlock_index
- return
- }
-
- if {$repo_config(gui.trustmtime) eq {true}} {
- switch_branch_stage2 {} $new_branch
- } else {
- set ui_status_value {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]
- fconfigure $fd_rf -blocking 0 -translation binary
- fileevent $fd_rf readable \
- [list switch_branch_stage2 $fd_rf $new_branch]
- }
-}
-
-proc switch_branch_stage2 {fd_rf new_branch} {
- global ui_status_value HEAD
-
- if {$fd_rf ne {}} {
- read $fd_rf
- if {![eof $fd_rf]} return
- close $fd_rf
- }
-
- set ui_status_value "Updating working directory to '$new_branch'..."
- set cmd [list git read-tree]
- lappend cmd -m
- lappend cmd -u
- lappend cmd --exclude-per-directory=.gitignore
- lappend cmd $HEAD
- lappend cmd $new_branch
- set fd_rt [open "| $cmd" r]
- fconfigure $fd_rt -blocking 0 -translation binary
- fileevent $fd_rt readable \
- [list switch_branch_readtree_wait $fd_rt $new_branch]
-}
-
-proc switch_branch_readtree_wait {fd_rt new_branch} {
- global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
- global current_branch
- global ui_comm ui_status_value
-
- # -- We never get interesting output on stdout; only stderr.
- #
- read $fd_rt
- fconfigure $fd_rt -blocking 1
- if {![eof $fd_rt]} {
- fconfigure $fd_rt -blocking 0
- return
- }
-
- # -- The working directory wasn't in sync with the index and
- # we'd have to overwrite something to make the switch. A
- # merge is required.
- #
- if {[catch {close $fd_rt} err]} {
- regsub {^fatal: } $err {} err
- warn_popup "File level merge required.
-
-$err
-
-Staying on branch '$current_branch'."
- set ui_status_value "Aborted checkout of '$new_branch' (file level merging is required)."
- unlock_index
- return
- }
-
- # -- Update the symbolic ref. Core git doesn't even check for failure
- # here, it Just Works(tm). If it doesn't we are in some really ugly
- # state that is difficult to recover from within git-gui.
- #
- if {[catch {git symbolic-ref HEAD "refs/heads/$new_branch"} err]} {
- error_popup "Failed to set current branch.
-
-This working directory is only partially switched. We successfully updated your files, but failed to update an internal Git file.
-
-This should not have occurred. [appname] will now close and give up.
-
-$err"
- do_quit
- return
- }
-
- # -- Update our repository state. If we were previously in amend mode
- # we need to toss the current buffer and do a full rescan to update
- # our file lists. If we weren't in amend mode our file lists are
- # accurate and we can avoid the rescan.
- #
- unlock_index
- set selected_commit_type new
- if {[string match amend* $commit_type]} {
- $ui_comm delete 0.0 end
- $ui_comm edit reset
- $ui_comm edit modified false
- rescan {set ui_status_value "Checked out branch '$current_branch'."}
- } else {
- repository_state commit_type HEAD MERGE_HEAD
- set PARENT $HEAD
- set ui_status_value "Checked out branch '$current_branch'."
- }
-}
diff --git a/git-gui/lib/branch_checkout.tcl b/git-gui/lib/branch_checkout.tcl
new file mode 100644
index 0000000..72c45b4
--- /dev/null
+++ b/git-gui/lib/branch_checkout.tcl
@@ -0,0 +1,89 @@
+# git-gui branch checkout support
+# Copyright (C) 2007 Shawn Pearce
+
+class branch_checkout {
+
+field w ; # widget path
+field w_rev ; # mega-widget to pick the initial revision
+
+field opt_fetch 1; # refetch tracking branch if used?
+field opt_detach 0; # force a detached head case?
+
+constructor dialog {} {
+ make_toplevel top w
+ wm title $top "[appname] ([reponame]): Checkout Branch"
+ if {$top ne {.}} {
+ wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
+ }
+
+ label $w.header -text {Checkout Branch} -font font_uibold
+ pack $w.header -side top -fill x
+
+ frame $w.buttons
+ button $w.buttons.create -text Checkout \
+ -default active \
+ -command [cb _checkout]
+ pack $w.buttons.create -side right
+ button $w.buttons.cancel -text {Cancel} \
+ -command [list destroy $w]
+ pack $w.buttons.cancel -side right -padx 5
+ pack $w.buttons -side bottom -fill x -pady 10 -padx 10
+
+ set w_rev [::choose_rev::new $w.rev {Revision}]
+ $w_rev bind_listbox <Double-Button-1> [cb _checkout]
+ pack $w.rev -anchor nw -fill both -expand 1 -pady 5 -padx 5
+
+ labelframe $w.options -text {Options}
+
+ checkbutton $w.options.fetch \
+ -text {Fetch Tracking Branch} \
+ -variable @opt_fetch
+ pack $w.options.fetch -anchor nw
+
+ checkbutton $w.options.detach \
+ -text {Detach From Local Branch} \
+ -variable @opt_detach
+ pack $w.options.detach -anchor nw
+
+ pack $w.options -anchor nw -fill x -pady 5 -padx 5
+
+ bind $w <Visibility> [cb _visible]
+ bind $w <Key-Escape> [list destroy $w]
+ bind $w <Key-Return> [cb _checkout]\;break
+ tkwait window $w
+}
+
+method _checkout {} {
+ set spec [$w_rev get_tracking_branch]
+ if {$spec ne {} && $opt_fetch} {
+ set new {}
+ } elseif {[catch {set new [$w_rev commit_or_die]}]} {
+ return
+ }
+
+ if {$opt_detach} {
+ set ref {}
+ } else {
+ set ref [$w_rev get_local_branch]
+ }
+
+ set co [::checkout_op::new [$w_rev get] $new $ref]
+ $co parent $w
+ $co enable_checkout 1
+ if {$spec ne {} && $opt_fetch} {
+ $co enable_fetch $spec
+ }
+
+ if {[$co run]} {
+ destroy $w
+ } else {
+ $w_rev focus_filter
+ }
+}
+
+method _visible {} {
+ grab $w
+ $w_rev focus_filter
+}
+
+}
diff --git a/git-gui/lib/branch_create.tcl b/git-gui/lib/branch_create.tcl
new file mode 100644
index 0000000..def615d
--- /dev/null
+++ b/git-gui/lib/branch_create.tcl
@@ -0,0 +1,220 @@
+# git-gui branch create support
+# Copyright (C) 2006, 2007 Shawn Pearce
+
+class branch_create {
+
+field w ; # widget path
+field w_rev ; # mega-widget to pick the initial revision
+field w_name ; # new branch name widget
+
+field name {}; # name of the branch the user has chosen
+field name_type user; # type of branch name to use
+
+field opt_merge ff; # type of merge to apply to existing branch
+field opt_checkout 1; # automatically checkout the new branch?
+field opt_fetch 1; # refetch tracking branch if used?
+field reset_ok 0; # did the user agree to reset?
+
+constructor dialog {} {
+ global repo_config
+
+ make_toplevel top w
+ wm title $top "[appname] ([reponame]): Create Branch"
+ if {$top ne {.}} {
+ wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
+ }
+
+ label $w.header -text {Create New Branch} -font font_uibold
+ pack $w.header -side top -fill x
+
+ frame $w.buttons
+ button $w.buttons.create -text Create \
+ -default active \
+ -command [cb _create]
+ pack $w.buttons.create -side right
+ button $w.buttons.cancel -text {Cancel} \
+ -command [list destroy $w]
+ pack $w.buttons.cancel -side right -padx 5
+ pack $w.buttons -side bottom -fill x -pady 10 -padx 10
+
+ labelframe $w.desc -text {Branch Name}
+ radiobutton $w.desc.name_r \
+ -anchor w \
+ -text {Name:} \
+ -value user \
+ -variable @name_type
+ set w_name $w.desc.name_t
+ entry $w_name \
+ -borderwidth 1 \
+ -relief sunken \
+ -width 40 \
+ -textvariable @name \
+ -validate key \
+ -validatecommand [cb _validate %d %S]
+ grid $w.desc.name_r $w_name -sticky we -padx {0 5}
+
+ radiobutton $w.desc.match_r \
+ -anchor w \
+ -text {Match Tracking Branch Name} \
+ -value match \
+ -variable @name_type
+ grid $w.desc.match_r -sticky we -padx {0 5} -columnspan 2
+
+ grid columnconfigure $w.desc 1 -weight 1
+ pack $w.desc -anchor nw -fill x -pady 5 -padx 5
+
+ set w_rev [::choose_rev::new $w.rev {Starting Revision}]
+ pack $w.rev -anchor nw -fill both -expand 1 -pady 5 -padx 5
+
+ labelframe $w.options -text {Options}
+
+ frame $w.options.merge
+ label $w.options.merge.l -text {Update Existing Branch:}
+ pack $w.options.merge.l -side left
+ radiobutton $w.options.merge.no \
+ -text No \
+ -value none \
+ -variable @opt_merge
+ pack $w.options.merge.no -side left
+ radiobutton $w.options.merge.ff \
+ -text {Fast Forward Only} \
+ -value ff \
+ -variable @opt_merge
+ pack $w.options.merge.ff -side left
+ radiobutton $w.options.merge.reset \
+ -text {Reset} \
+ -value reset \
+ -variable @opt_merge
+ pack $w.options.merge.reset -side left
+ pack $w.options.merge -anchor nw
+
+ checkbutton $w.options.fetch \
+ -text {Fetch Tracking Branch} \
+ -variable @opt_fetch
+ pack $w.options.fetch -anchor nw
+
+ checkbutton $w.options.checkout \
+ -text {Checkout After Creation} \
+ -variable @opt_checkout
+ pack $w.options.checkout -anchor nw
+ pack $w.options -anchor nw -fill x -pady 5 -padx 5
+
+ trace add variable @name_type write [cb _select]
+
+ set name $repo_config(gui.newbranchtemplate)
+ if {[is_config_true gui.matchtrackingbranch]} {
+ set name_type match
+ }
+
+ bind $w <Visibility> [cb _visible]
+ bind $w <Key-Escape> [list destroy $w]
+ bind $w <Key-Return> [cb _create]\;break
+ tkwait window $w
+}
+
+method _create {} {
+ global repo_config
+ global M1B
+
+ set spec [$w_rev get_tracking_branch]
+ switch -- $name_type {
+ user {
+ set newbranch $name
+ }
+ match {
+ if {$spec eq {}} {
+ tk_messageBox \
+ -icon error \
+ -type ok \
+ -title [wm title $w] \
+ -parent $w \
+ -message "Please select a tracking branch."
+ return
+ }
+ if {![regsub ^refs/heads/ [lindex $spec 2] {} newbranch]} {
+ tk_messageBox \
+ -icon error \
+ -type ok \
+ -title [wm title $w] \
+ -parent $w \
+ -message "Tracking branch [$w get] is not a branch in the remote repository."
+ return
+ }
+ }
+ }
+
+ if {$newbranch eq {}
+ || $newbranch eq $repo_config(gui.newbranchtemplate)} {
+ tk_messageBox \
+ -icon error \
+ -type ok \
+ -title [wm title $w] \
+ -parent $w \
+ -message "Please supply a branch name."
+ focus $w_name
+ return
+ }
+
+ if {[catch {git check-ref-format "heads/$newbranch"}]} {
+ tk_messageBox \
+ -icon error \
+ -type ok \
+ -title [wm title $w] \
+ -parent $w \
+ -message "'$newbranch' is not an acceptable branch name."
+ focus $w_name
+ return
+ }
+
+ if {$spec ne {} && $opt_fetch} {
+ set new {}
+ } elseif {[catch {set new [$w_rev commit_or_die]}]} {
+ return
+ }
+
+ set co [::checkout_op::new \
+ [$w_rev get] \
+ $new \
+ refs/heads/$newbranch]
+ $co parent $w
+ $co enable_create 1
+ $co enable_merge $opt_merge
+ $co enable_checkout $opt_checkout
+ if {$spec ne {} && $opt_fetch} {
+ $co enable_fetch $spec
+ }
+
+ if {[$co run]} {
+ destroy $w
+ } else {
+ focus $w_name
+ }
+}
+
+method _validate {d S} {
+ if {$d == 1} {
+ if {[regexp {[~^:?*\[\0- ]} $S]} {
+ return 0
+ }
+ if {[string length $S] > 0} {
+ set name_type user
+ }
+ }
+ return 1
+}
+
+method _select {args} {
+ if {$name_type eq {match}} {
+ $w_rev pick_tracking_branch
+ }
+}
+
+method _visible {} {
+ grab $w
+ if {$name_type eq {user}} {
+ $w_name icursor end
+ focus $w_name
+ }
+}
+
+}
diff --git a/git-gui/lib/branch_delete.tcl b/git-gui/lib/branch_delete.tcl
new file mode 100644
index 0000000..c7573c6
--- /dev/null
+++ b/git-gui/lib/branch_delete.tcl
@@ -0,0 +1,149 @@
+# git-gui branch delete support
+# Copyright (C) 2007 Shawn Pearce
+
+class branch_delete {
+
+field w ; # widget path
+field w_heads ; # listbox of local head names
+field w_check ; # revision picker for merge test
+field w_delete ; # delete button
+
+constructor dialog {} {
+ global current_branch
+
+ make_toplevel top w
+ wm title $top "[appname] ([reponame]): Delete Branch"
+ if {$top ne {.}} {
+ wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
+ }
+
+ label $w.header -text {Delete Local Branch} -font font_uibold
+ pack $w.header -side top -fill x
+
+ frame $w.buttons
+ set w_delete $w.buttons.delete
+ button $w_delete \
+ -text Delete \
+ -default active \
+ -state disabled \
+ -command [cb _delete]
+ pack $w_delete -side right
+ button $w.buttons.cancel \
+ -text {Cancel} \
+ -command [list destroy $w]
+ pack $w.buttons.cancel -side right -padx 5
+ pack $w.buttons -side bottom -fill x -pady 10 -padx 10
+
+ labelframe $w.list -text {Local Branches}
+ set w_heads $w.list.l
+ listbox $w_heads \
+ -height 10 \
+ -width 70 \
+ -selectmode extended \
+ -exportselection false \
+ -yscrollcommand [list $w.list.sby set]
+ scrollbar $w.list.sby -command [list $w.list.l yview]
+ pack $w.list.sby -side right -fill y
+ pack $w.list.l -side left -fill both -expand 1
+ pack $w.list -fill both -expand 1 -pady 5 -padx 5
+
+ set w_check [choose_rev::new \
+ $w.check \
+ {Delete Only If Merged Into} \
+ ]
+ $w_check none {Always (Do not perform merge test.)}
+ pack $w.check -anchor nw -fill x -pady 5 -padx 5
+
+ foreach h [load_all_heads] {
+ if {$h ne $current_branch} {
+ $w_heads insert end $h
+ }
+ }
+
+ bind $w_heads <<ListboxSelect>> [cb _select]
+ bind $w <Visibility> "
+ grab $w
+ focus $w
+ "
+ bind $w <Key-Escape> [list destroy $w]
+ bind $w <Key-Return> [cb _delete]\;break
+ tkwait window $w
+}
+
+method _select {} {
+ if {[$w_heads curselection] eq {}} {
+ $w_delete configure -state disabled
+ } else {
+ $w_delete configure -state normal
+ }
+}
+
+method _delete {} {
+ if {[catch {set check_cmt [$w_check commit_or_die]}]} {
+ return
+ }
+
+ set to_delete [list]
+ set not_merged [list]
+ foreach i [$w_heads curselection] {
+ set b [$w_heads get $i]
+ if {[catch {
+ set o [git rev-parse --verify "refs/heads/$b"]
+ }]} continue
+ if {$check_cmt ne {}} {
+ if {[catch {set m [git merge-base $o $check_cmt]}]} continue
+ if {$o ne $m} {
+ lappend not_merged $b
+ continue
+ }
+ }
+ lappend to_delete [list $b $o]
+ }
+ if {$not_merged ne {}} {
+ set msg "The following branches are not completely merged into [$w_check get]:
+
+ - [join $not_merged "\n - "]"
+ tk_messageBox \
+ -icon info \
+ -type ok \
+ -title [wm title $w] \
+ -parent $w \
+ -message $msg
+ }
+ if {$to_delete eq {}} return
+ if {$check_cmt eq {}} {
+ set msg {Recovering deleted branches is difficult.
+
+Delete the selected branches?}
+ if {[tk_messageBox \
+ -icon warning \
+ -type yesno \
+ -title [wm title $w] \
+ -parent $w \
+ -message $msg] ne yes} {
+ return
+ }
+ }
+
+ set failed {}
+ foreach i $to_delete {
+ set b [lindex $i 0]
+ set o [lindex $i 1]
+ if {[catch {git update-ref -d "refs/heads/$b" $o} err]} {
+ append failed " - $b: $err\n"
+ }
+ }
+
+ if {$failed ne {}} {
+ tk_messageBox \
+ -icon error \
+ -type ok \
+ -title [wm title $w] \
+ -parent $w \
+ -message "Failed to delete branches:\n$failed"
+ }
+
+ destroy $w
+}
+
+}
diff --git a/git-gui/lib/branch_rename.tcl b/git-gui/lib/branch_rename.tcl
new file mode 100644
index 0000000..1cadc31
--- /dev/null
+++ b/git-gui/lib/branch_rename.tcl
@@ -0,0 +1,128 @@
+# git-gui branch rename support
+# Copyright (C) 2007 Shawn Pearce
+
+class branch_rename {
+
+field w
+field oldname
+field newname
+
+constructor dialog {} {
+ global current_branch
+
+ make_toplevel top w
+ wm title $top "[appname] ([reponame]): Rename Branch"
+ if {$top ne {.}} {
+ wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
+ }
+
+ set oldname $current_branch
+ set newname [get_config gui.newbranchtemplate]
+
+ label $w.header -text {Rename Branch} -font font_uibold
+ pack $w.header -side top -fill x
+
+ frame $w.buttons
+ button $w.buttons.rename -text Rename \
+ -default active \
+ -command [cb _rename]
+ pack $w.buttons.rename -side right
+ button $w.buttons.cancel -text {Cancel} \
+ -command [list destroy $w]
+ pack $w.buttons.cancel -side right -padx 5
+ pack $w.buttons -side bottom -fill x -pady 10 -padx 10
+
+ frame $w.rename
+ label $w.rename.oldname_l -text {Branch:}
+ eval tk_optionMenu $w.rename.oldname_m @oldname [load_all_heads]
+
+ label $w.rename.newname_l -text {New Name:}
+ entry $w.rename.newname_t \
+ -borderwidth 1 \
+ -relief sunken \
+ -width 40 \
+ -textvariable @newname \
+ -validate key \
+ -validatecommand {
+ if {%d == 1 && [regexp {[~^:?*\[\0- ]} %S]} {return 0}
+ return 1
+ }
+
+ grid $w.rename.oldname_l $w.rename.oldname_m -sticky w -padx {0 5}
+ grid $w.rename.newname_l $w.rename.newname_t -sticky we -padx {0 5}
+ grid columnconfigure $w.rename 1 -weight 1
+ pack $w.rename -anchor nw -fill x -pady 5 -padx 5
+
+ bind $w <Key-Return> [cb _rename]
+ bind $w <Key-Escape> [list destroy $w]
+ bind $w <Visibility> "
+ grab $w
+ $w.rename.newname_t icursor end
+ focus $w.rename.newname_t
+ "
+ tkwait window $w
+}
+
+method _rename {} {
+ global current_branch
+
+ if {$oldname eq {}} {
+ tk_messageBox \
+ -icon error \
+ -type ok \
+ -title [wm title $w] \
+ -parent $w \
+ -message "Please select a branch to rename."
+ focus $w.rename.oldname_m
+ return
+ }
+ if {$newname eq {}
+ || $newname eq [get_config gui.newbranchtemplate]} {
+ tk_messageBox \
+ -icon error \
+ -type ok \
+ -title [wm title $w] \
+ -parent $w \
+ -message "Please supply a branch name."
+ focus $w.rename.newname_t
+ return
+ }
+ if {![catch {git show-ref --verify -- "refs/heads/$newname"}]} {
+ tk_messageBox \
+ -icon error \
+ -type ok \
+ -title [wm title $w] \
+ -parent $w \
+ -message "Branch '$newname' already exists."
+ focus $w.rename.newname_t
+ return
+ }
+ if {[catch {git check-ref-format "heads/$newname"}]} {
+ tk_messageBox \
+ -icon error \
+ -type ok \
+ -title [wm title $w] \
+ -parent $w \
+ -message "We do not like '$newname' as a branch name."
+ focus $w.rename.newname_t
+ return
+ }
+
+ if {[catch {git branch -m $oldname $newname} err]} {
+ tk_messageBox \
+ -icon error \
+ -type ok \
+ -title [wm title $w] \
+ -parent $w \
+ -message "Failed to rename '$oldname'.\n\n$err"
+ return
+ }
+
+ if {$current_branch eq $oldname} {
+ set current_branch $newname
+ }
+
+ destroy $w
+}
+
+}
diff --git a/git-gui/lib/browser.tcl b/git-gui/lib/browser.tcl
index e612247..888db3c 100644
--- a/git-gui/lib/browser.tcl
+++ b/git-gui/lib/browser.tcl
@@ -3,6 +3,13 @@
class browser {
+image create photo ::browser::img_parent -data {R0lGODlhEAAQAIUAAPwCBBxSHBxOHMTSzNzu3KzCtBRGHCSKFIzCjLzSxBQ2FAxGHDzCLCyeHBQ+FHSmfAwuFBxKLDSCNMzizISyjJzOnDSyLAw+FAQSDAQeDBxWJAwmDAQOBKzWrDymNAQaDAQODAwaDDyKTFSyXFTGTEy6TAQCBAQKDAwiFBQyHAwSFAwmHAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAZ1QIBwSCwaj0hiQCBICpcDQsFgGAaIguhhi0gohIsrQEDYMhiNrRfgeAQC5fMCAolIDhD2hFI5WC4YRBkaBxsOE2l/RxsHHA4dHmkfRyAbIQ4iIyQlB5NFGCAACiakpSZEJyinTgAcKSesACorgU4mJ6uxR35BACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs=}
+image create photo ::browser::img_rblob -data {R0lGODlhEAAQAIUAAPwCBFxaXNze3Ly2rJSWjPz+/Ozq7GxqbJyanPT29HRydMzOzDQyNIyKjERCROTi3Pz69PTy7Pzy7PTu5Ozm3LyqlJyWlJSSjJSOhOzi1LyulPz27PTq3PTm1OzezLyqjIyKhJSKfOzaxPz29OzizLyidIyGdIyCdOTOpLymhOzavOTStMTCtMS+rMS6pMSynMSulLyedAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAaQQIAQECgajcNkQMBkDgKEQFK4LFgLhkMBIVUKroWEYlEgMLxbBKLQUBwc52HgAQ4LBo049atWQyIPA3pEdFcQEhMUFYNVagQWFxgZGoxfYRsTHB0eH5UJCJAYICEinUoPIxIcHCQkIiIllQYEGCEhJicoKYwPmiQeKisrKLFKLCwtLi8wHyUlMYwM0tPUDH5BACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs=}
+image create photo ::browser::img_xblob -data {R0lGODlhEAAQAIYAAPwCBFRWVFxaXNza3OTi3Nze3Ly2tJyanPz+/Ozq7GxubNzSxMzOzMTGxHRybDQyNLy+vHRydHx6fKSipISChIyKjGxqbERCRCwuLLy6vGRiZExKTCQiJAwKDLSytLy2rJSSlHx+fDw6PKyqrBQWFPTu5Ozm3LyulLS2tCQmJAQCBPTq3Ozi1MSynCwqLAQGBOTazOzizOzezLyqjBweHNzSvOzaxKyurHRuZNzOtLymhDw+PIyCdOzWvOTOpLyidNzKtOTStLyifMTCtMS+rLyedAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAfZgACCAAEChYeGg4oCAwQFjgYBBwGKggEECJkICQoIkwADCwwNDY2mDA4Lng8QDhESsLARExQVDhYXGBkWExIaGw8cHR4SCQQfFQ8eFgUgIQEiwiMSBMYfGB4atwEXDyQd0wQlJicPKAHoFyIpJCoeDgMrLC0YKBsX6i4kL+4OMDEyZijr5oLGNxUqUCioEcPGDAwjPNyI6MEDChQjcOSwsUDHgw07RIgI4KCkAgs8cvTw8eOBogAxQtXIASTISiEuBwUYMoRIixYnZggpUgTDywdIkWJIitRPIAAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7}
+image create photo ::browser::img_tree -data {R0lGODlhEAAQAIYAAPwCBAQCBExKTBwWHMzKzOzq7ERCRExGTCwqLARqnAQ+ZHR2dKyqrNTOzHx2fCQiJMTi9NTu9HzC3AxmnAQ+XPTm7Dy67DymzITC3IzG5AxypHRydKymrMzOzOzu7BweHByy9AyGtFyy1IzG3NTu/ARupFRSVByazBR6rAyGvFyuzJTK3MTm9BR+tAxWhHS61MTi7Pz+/IymvCxulBRelAx2rHS63Pz6/PTy9PTu9Nza3ISitBRupFSixNTS1CxqnDQyNMzGzOTi5MTCxMTGxGxubGxqbLy2vLSutGRiZLy6vLSytKyurDQuNFxaXKSipDw6PAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAfDgACCAAECg4eIAAMEBQYHCImDBgkKCwwNBQIBBw4Bhw8QERITFJYEFQUFnoIPFhcYoRkaFBscHR4Ggh8gIRciEiMQJBkltCa6JyUoKSkXKhIrLCQYuQAPLS4TEyUhKb0qLzDVAjEFMjMuNBMoNcw21QY3ODkFOjs82RM1PfDzFRU3fOggcM7Fj2pAgggRokOHDx9DhhAZUqQaISBGhjwMEvEIkiIHEgUAkgSJkiNLmFSMJChAEydPGBSBwvJQgAc0/QQCACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs=}
+image create photo ::browser::img_symlink -data {R0lGODlhEAAQAIQAAPwCBCwqLLSytLy+vERGRFRWVDQ2NKSmpAQCBKyurMTGxISChJyanHR2dIyKjGxubHRydGRmZIyOjFxeXHx6fAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAVbICACwWieY1CibCCsrBkMb0zchSEcNYskCtqBBzshFkOGQFk0IRqOxqPBODRHCMhCQKteRc9FI/KQWGOIyFYgkDC+gPR4snCcfRGKOIKIgSMQE31+f4OEYCZ+IQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7}
+image create photo ::browser::img_unknown -data {R0lGODlhEAAQAIUAAPwCBFxaXIyKjNTW1Nze3LS2tJyanER2RGS+VPz+/PTu5GxqbPz69BQ6BCxeLFSqRPT29HRydMzOzDQyNERmPKSypCRWHIyKhERCRDyGPKz2nESiLBxGHCyCHGxubPz6/PTy7Ozi1Ly2rKSipOzm3LyqlKSWhCRyFOzizLymhNTKtNzOvOzaxOTStPz27OzWvOTOpLSupLyedMS+rMS6pMSulLyqjLymfLyifAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAamQIAQECgajcOkYEBoDgoBQyAJOCCuiENCsWBIh9aGw9F4HCARiXciRDQoBUnlYRlcIgsMG5CxXAgMGhscBRAEBRd7AB0eBBoIgxUfICEiikSPgyMMIAokJZcBkBybJgomIaBJAZoMpyCmqkMBFCcVCrgKKAwpoSorKqchKCwtvasIFBIhLiYvLzDHsxQNMcMKLDAwMqEz3jQ1NTY3ONyrE+jp6hN+QQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7}
+
field w
field browser_commit
field browser_path
@@ -13,13 +20,13 @@ field browser_busy 1
field ls_buf {}; # Buffered record output from ls-tree
-constructor new {commit} {
+constructor new {commit {path {}}} {
global cursor_ptr M1B
make_toplevel top w
wm title $top "[appname] ([reponame]): File Browser"
set browser_commit $commit
- set browser_path $browser_commit:
+ set browser_path $browser_commit:$path
label $w.path \
-textvariable @browser_path \
@@ -73,7 +80,11 @@ constructor new {commit} {
bind $w_list <Visibility> [list focus $w_list]
set w $w_list
- _ls $this $browser_commit
+ if {$path ne {}} {
+ _ls $this $browser_commit:$path $path
+ } else {
+ _ls $this $browser_commit $path
+ }
return $this
}
@@ -173,15 +184,14 @@ method _ls {tree_id {name {}}} {
$w image create end \
-align center -padx 5 -pady 1 \
-name icon0 \
- -image file_uplevel
+ -image ::browser::img_parent
$w insert end {[Up To Parent]}
lappend browser_files parent
}
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]
}
@@ -204,14 +214,21 @@ method _read {fd} {
switch -- $type {
blob {
- set image file_mod
+ scan [lindex $info 0] %o mode
+ if {$mode == 0120000} {
+ set image ::browser::img_symlink
+ } elseif {($mode & 0100) != 0} {
+ set image ::browser::img_xblob
+ } else {
+ set image ::browser::img_rblob
+ }
}
tree {
- set image file_dir
+ set image ::browser::img_tree
append path /
}
default {
- set image file_question
+ set image ::browser::img_unknown
}
}
@@ -240,3 +257,56 @@ method _read {fd} {
}
}
+
+class browser_open {
+
+field w ; # widget path
+field w_rev ; # mega-widget to pick the initial revision
+
+constructor dialog {} {
+ make_toplevel top w
+ wm title $top "[appname] ([reponame]): Browse Branch Files"
+ if {$top ne {.}} {
+ wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
+ }
+
+ label $w.header \
+ -text {Browse Branch Files} \
+ -font font_uibold
+ pack $w.header -side top -fill x
+
+ frame $w.buttons
+ button $w.buttons.browse -text Browse \
+ -default active \
+ -command [cb _open]
+ pack $w.buttons.browse -side right
+ button $w.buttons.cancel -text {Cancel} \
+ -command [list destroy $w]
+ pack $w.buttons.cancel -side right -padx 5
+ pack $w.buttons -side bottom -fill x -pady 10 -padx 10
+
+ set w_rev [::choose_rev::new $w.rev {Revision}]
+ $w_rev bind_listbox <Double-Button-1> [cb _open]
+ pack $w.rev -anchor nw -fill both -expand 1 -pady 5 -padx 5
+
+ bind $w <Visibility> [cb _visible]
+ bind $w <Key-Escape> [list destroy $w]
+ bind $w <Key-Return> [cb _open]\;break
+ tkwait window $w
+}
+
+method _open {} {
+ if {[catch {$w_rev commit_or_die} err]} {
+ return
+ }
+ set name [$w_rev get]
+ destroy $w
+ browser::new $name
+}
+
+method _visible {} {
+ grab $w
+ $w_rev focus_filter
+}
+
+}
diff --git a/git-gui/lib/checkout_op.tcl b/git-gui/lib/checkout_op.tcl
new file mode 100644
index 0000000..170f737
--- /dev/null
+++ b/git-gui/lib/checkout_op.tcl
@@ -0,0 +1,588 @@
+# git-gui commit checkout support
+# Copyright (C) 2007 Shawn Pearce
+
+class checkout_op {
+
+field w {}; # our window (if we have one)
+field w_cons {}; # embedded console window object
+
+field new_expr ; # expression the user saw/thinks this is
+field new_hash ; # commit SHA-1 we are switching to
+field new_ref ; # ref we are updating/creating
+
+field parent_w .; # window that started us
+field merge_type none; # type of merge to apply to existing branch
+field merge_base {}; # merge base if we have another ref involved
+field fetch_spec {}; # refetch tracking branch if used?
+field checkout 1; # actually checkout the branch?
+field create 0; # create the branch if it doesn't exist?
+
+field reset_ok 0; # did the user agree to reset?
+field fetch_ok 0; # did the fetch succeed?
+
+field readtree_d {}; # buffered output from read-tree
+field update_old {}; # was the update-ref call deferred?
+field reflog_msg {}; # log message for the update-ref call
+
+constructor new {expr hash {ref {}}} {
+ set new_expr $expr
+ set new_hash $hash
+ set new_ref $ref
+
+ return $this
+}
+
+method parent {path} {
+ set parent_w [winfo toplevel $path]
+}
+
+method enable_merge {type} {
+ set merge_type $type
+}
+
+method enable_fetch {spec} {
+ set fetch_spec $spec
+}
+
+method enable_checkout {co} {
+ set checkout $co
+}
+
+method enable_create {co} {
+ set create $co
+}
+
+method run {} {
+ if {$fetch_spec ne {}} {
+ global M1B
+
+ # We were asked to refresh a single tracking branch
+ # before we get to work. We should do that before we
+ # consider any ref updating.
+ #
+ set fetch_ok 0
+ set l_trck [lindex $fetch_spec 0]
+ set remote [lindex $fetch_spec 1]
+ set r_head [lindex $fetch_spec 2]
+ regsub ^refs/heads/ $r_head {} r_name
+
+ set cmd [list git fetch $remote]
+ if {$l_trck ne {}} {
+ lappend cmd +$r_head:$l_trck
+ } else {
+ lappend cmd $r_head
+ }
+
+ _toplevel $this {Refreshing Tracking Branch}
+ set w_cons [::console::embed \
+ $w.console \
+ "Fetching $r_name from $remote"]
+ pack $w.console -fill both -expand 1
+ $w_cons exec $cmd [cb _finish_fetch]
+
+ bind $w <$M1B-Key-w> break
+ bind $w <$M1B-Key-W> break
+ bind $w <Visibility> "
+ [list grab $w]
+ [list focus $w]
+ "
+ wm protocol $w WM_DELETE_WINDOW [cb _noop]
+ tkwait window $w
+
+ if {!$fetch_ok} {
+ delete_this
+ return 0
+ }
+ }
+
+ if {$new_ref ne {}} {
+ # If we have a ref we need to update it before we can
+ # proceed with a checkout (if one was enabled).
+ #
+ if {![_update_ref $this]} {
+ delete_this
+ return 0
+ }
+ }
+
+ if {$checkout} {
+ _checkout $this
+ return 1
+ }
+
+ delete_this
+ return 1
+}
+
+method _noop {} {}
+
+method _finish_fetch {ok} {
+ if {$ok} {
+ set l_trck [lindex $fetch_spec 0]
+ if {$l_trck eq {}} {
+ set l_trck FETCH_HEAD
+ }
+ if {[catch {set new_hash [git rev-parse --verify "$l_trck^0"]} err]} {
+ set ok 0
+ $w_cons insert "fatal: Cannot resolve $l_trck"
+ $w_cons insert $err
+ }
+ }
+
+ $w_cons done $ok
+ set w_cons {}
+ wm protocol $w WM_DELETE_WINDOW {}
+
+ if {$ok} {
+ destroy $w
+ set w {}
+ } else {
+ button $w.close -text Close -command [list destroy $w]
+ pack $w.close -side bottom -anchor e -padx 10 -pady 10
+ }
+
+ set fetch_ok $ok
+}
+
+method _update_ref {} {
+ global null_sha1 current_branch
+
+ set ref $new_ref
+ set new $new_hash
+
+ set is_current 0
+ set rh refs/heads/
+ set rn [string length $rh]
+ if {[string equal -length $rn $rh $ref]} {
+ set newbranch [string range $ref $rn end]
+ if {$current_branch eq $newbranch} {
+ set is_current 1
+ }
+ } else {
+ set newbranch $ref
+ }
+
+ if {[catch {set cur [git rev-parse --verify "$ref^0"]}]} {
+ # Assume it does not exist, and that is what the error was.
+ #
+ if {!$create} {
+ _error $this "Branch '$newbranch' does not exist."
+ return 0
+ }
+
+ set reflog_msg "branch: Created from $new_expr"
+ set cur $null_sha1
+ } elseif {$create && $merge_type eq {none}} {
+ # We were told to create it, but not do a merge.
+ # Bad. Name shouldn't have existed.
+ #
+ _error $this "Branch '$newbranch' already exists."
+ return 0
+ } elseif {!$create && $merge_type eq {none}} {
+ # We aren't creating, it exists and we don't merge.
+ # We are probably just a simple branch switch.
+ # Use whatever value we just read.
+ #
+ set new $cur
+ set new_hash $cur
+ } elseif {$new eq $cur} {
+ # No merge would be required, don't compute anything.
+ #
+ } else {
+ catch {set merge_base [git merge-base $new $cur]}
+ if {$merge_base eq $cur} {
+ # The current branch is older.
+ #
+ set reflog_msg "merge $new_expr: Fast-forward"
+ } else {
+ switch -- $merge_type {
+ ff {
+ if {$merge_base eq $new} {
+ # The current branch is actually newer.
+ #
+ set new $cur
+ set new_hash $cur
+ } else {
+ _error $this "Branch '$newbranch' already exists.\n\nIt cannot fast-forward to $new_expr.\nA merge is required."
+ return 0
+ }
+ }
+ reset {
+ # The current branch will lose things.
+ #
+ if {[_confirm_reset $this $cur]} {
+ set reflog_msg "reset $new_expr"
+ } else {
+ return 0
+ }
+ }
+ default {
+ _error $this "Merge strategy '$merge_type' not supported."
+ return 0
+ }
+ }
+ }
+ }
+
+ if {$new ne $cur} {
+ if {$is_current} {
+ # No so fast. We should defer this in case
+ # we cannot update the working directory.
+ #
+ set update_old $cur
+ return 1
+ }
+
+ if {[catch {
+ git update-ref -m $reflog_msg $ref $new $cur
+ } err]} {
+ _error $this "Failed to update '$newbranch'.\n\n$err"
+ return 0
+ }
+ }
+
+ return 1
+}
+
+method _checkout {} {
+ if {[lock_index checkout_op]} {
+ after idle [cb _start_checkout]
+ } else {
+ _error $this "Staging area (index) is already locked."
+ delete_this
+ }
+}
+
+method _start_checkout {} {
+ global HEAD commit_type
+
+ # -- Our in memory state should match the repository.
+ #
+ repository_state curType curHEAD curMERGE_HEAD
+ if {[string match amend* $commit_type]
+ && $curType eq {normal}
+ && $curHEAD eq $HEAD} {
+ } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
+ info_popup {Last scanned state does not match repository state.
+
+Another Git program has modified this repository since the last scan. A rescan must be performed before the current branch can be changed.
+
+The rescan will be automatically started now.
+}
+ unlock_index
+ rescan ui_ready
+ delete_this
+ return
+ }
+
+ if {$curHEAD eq $new_hash} {
+ _after_readtree $this
+ } elseif {[is_config_true gui.trustmtime]} {
+ _readtree $this
+ } else {
+ ui_status {Refreshing file status...}
+ set fd [git_read update-index \
+ -q \
+ --unmerged \
+ --ignore-missing \
+ --refresh \
+ ]
+ fconfigure $fd -blocking 0 -translation binary
+ fileevent $fd readable [cb _refresh_wait $fd]
+ }
+}
+
+method _refresh_wait {fd} {
+ read $fd
+ if {[eof $fd]} {
+ close $fd
+ _readtree $this
+ }
+}
+
+method _name {} {
+ if {$new_ref eq {}} {
+ return [string range $new_hash 0 7]
+ }
+
+ set rh refs/heads/
+ set rn [string length $rh]
+ if {[string equal -length $rn $rh $new_ref]} {
+ return [string range $new_ref $rn end]
+ } else {
+ return $new_ref
+ }
+}
+
+method _readtree {} {
+ global HEAD
+
+ set readtree_d {}
+ $::main_status start \
+ "Updating working directory to '[_name $this]'..." \
+ {files checked out}
+
+ 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]
+}
+
+method _readtree_wait {fd} {
+ global current_branch
+
+ set buf [read $fd]
+ $::main_status update_meter $buf
+ append readtree_d $buf
+
+ fconfigure $fd -blocking 1
+ if {![eof $fd]} {
+ fconfigure $fd -blocking 0
+ return
+ }
+
+ if {[catch {close $fd}]} {
+ set err $readtree_d
+ regsub {^fatal: } $err {} err
+ $::main_status stop "Aborted checkout of '[_name $this]' (file level merging is required)."
+ warn_popup "File level merge required.
+
+$err
+
+Staying on branch '$current_branch'."
+ unlock_index
+ delete_this
+ return
+ }
+
+ $::main_status stop
+ _after_readtree $this
+}
+
+method _after_readtree {} {
+ global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
+ global current_branch is_detached
+ global ui_comm
+
+ set name [_name $this]
+ set log "checkout: moving"
+ if {!$is_detached} {
+ append log " from $current_branch"
+ }
+
+ # -- Move/create HEAD as a symbolic ref. Core git does not
+ # even check for failure here, it Just Works(tm). If it
+ # doesn't we are in some really ugly state that is difficult
+ # to recover from within git-gui.
+ #
+ set rh refs/heads/
+ set rn [string length $rh]
+ if {[string equal -length $rn $rh $new_ref]} {
+ set new_branch [string range $new_ref $rn end]
+ if {$is_detached || $current_branch ne $new_branch} {
+ append log " to $new_branch"
+ if {[catch {
+ git symbolic-ref -m $log HEAD $new_ref
+ } err]} {
+ _fatal $this $err
+ }
+ set current_branch $new_branch
+ set is_detached 0
+ }
+ } else {
+ if {$new_hash ne $HEAD} {
+ append log " to $new_expr"
+ if {[catch {
+ _detach_HEAD $log $new_hash
+ } err]} {
+ _fatal $this $err
+ }
+ }
+ set current_branch HEAD
+ set is_detached 1
+ }
+
+ # -- We had to defer updating the branch itself until we
+ # knew the working directory would update. So now we
+ # need to finish that work. If it fails we're in big
+ # trouble.
+ #
+ if {$update_old ne {}} {
+ if {[catch {
+ git update-ref \
+ -m $reflog_msg \
+ $new_ref \
+ $new_hash \
+ $update_old
+ } err]} {
+ _fatal $this $err
+ }
+ }
+
+ if {$is_detached} {
+ info_popup "You are no longer on a local branch.
+
+If you wanted to be on a branch, create one now starting from 'This Detached Checkout'."
+ }
+
+ # -- Update our repository state. If we were previously in
+ # amend mode we need to toss the current buffer and do a
+ # full rescan to update our file lists. If we weren't in
+ # amend mode our file lists are accurate and we can avoid
+ # the rescan.
+ #
+ unlock_index
+ set selected_commit_type new
+ if {[string match amend* $commit_type]} {
+ $ui_comm delete 0.0 end
+ $ui_comm edit reset
+ $ui_comm edit modified false
+ rescan [list ui_status "Checked out '$name'."]
+ } else {
+ repository_state commit_type HEAD MERGE_HEAD
+ set PARENT $HEAD
+ ui_status "Checked out '$name'."
+ }
+ delete_this
+}
+
+git-version proc _detach_HEAD {log new} {
+ >= 1.5.3 {
+ git update-ref --no-deref -m $log HEAD $new
+ }
+ default {
+ set p [gitdir HEAD]
+ file delete $p
+ set fd [open $p w]
+ fconfigure $fd -translation lf -encoding utf-8
+ puts $fd $new
+ close $fd
+ }
+}
+
+method _confirm_reset {cur} {
+ set reset_ok 0
+ set name [_name $this]
+ set gitk [list do_gitk [list $cur ^$new_hash]]
+
+ _toplevel $this {Confirm Branch Reset}
+ pack [label $w.msg1 \
+ -anchor w \
+ -justify left \
+ -text "Resetting '$name' to $new_expr will lose the following commits:" \
+ ] -anchor w
+
+ set list $w.list.l
+ frame $w.list
+ text $list \
+ -font font_diff \
+ -width 80 \
+ -height 10 \
+ -wrap none \
+ -xscrollcommand [list $w.list.sbx set] \
+ -yscrollcommand [list $w.list.sby set]
+ scrollbar $w.list.sbx -orient h -command [list $list xview]
+ scrollbar $w.list.sby -orient v -command [list $list yview]
+ pack $w.list.sbx -fill x -side bottom
+ pack $w.list.sby -fill y -side right
+ pack $list -fill both -expand 1
+ pack $w.list -fill both -expand 1 -padx 5 -pady 5
+
+ pack [label $w.msg2 \
+ -anchor w \
+ -justify left \
+ -text {Recovering lost commits may not be easy.} \
+ ]
+ pack [label $w.msg3 \
+ -anchor w \
+ -justify left \
+ -text "Reset '$name'?" \
+ ]
+
+ frame $w.buttons
+ button $w.buttons.visualize \
+ -text Visualize \
+ -command $gitk
+ pack $w.buttons.visualize -side left
+ button $w.buttons.reset \
+ -text Reset \
+ -command "
+ set @reset_ok 1
+ destroy $w
+ "
+ pack $w.buttons.reset -side right
+ button $w.buttons.cancel \
+ -default active \
+ -text Cancel \
+ -command [list destroy $w]
+ pack $w.buttons.cancel -side right -padx 5
+ pack $w.buttons -side bottom -fill x -pady 10 -padx 10
+
+ 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]
+ $list insert end "$abbr $subj\n"
+ }
+ close $fd
+ $list configure -state disabled
+
+ bind $w <Key-v> $gitk
+ bind $w <Visibility> "
+ grab $w
+ focus $w.buttons.cancel
+ "
+ bind $w <Key-Return> [list destroy $w]
+ bind $w <Key-Escape> [list destroy $w]
+ tkwait window $w
+ return $reset_ok
+}
+
+method _error {msg} {
+ if {[winfo ismapped $parent_w]} {
+ set p $parent_w
+ } else {
+ set p .
+ }
+
+ tk_messageBox \
+ -icon error \
+ -type ok \
+ -title [wm title $p] \
+ -parent $p \
+ -message $msg
+}
+
+method _toplevel {title} {
+ regsub -all {::} $this {__} w
+ set w .$w
+
+ if {[winfo ismapped $parent_w]} {
+ set p $parent_w
+ } else {
+ set p .
+ }
+
+ toplevel $w
+ wm title $w $title
+ wm geometry $w "+[winfo rootx $p]+[winfo rooty $p]"
+}
+
+method _fatal {err} {
+ error_popup "Failed to set current branch.
+
+This working directory is only partially switched. We successfully updated your files, but failed to update an internal Git file.
+
+This should not have occurred. [appname] will now close and give up.
+
+$err"
+ exit 1
+}
+
+}
diff --git a/git-gui/lib/choose_rev.tcl b/git-gui/lib/choose_rev.tcl
new file mode 100644
index 0000000..ec064b3
--- /dev/null
+++ b/git-gui/lib/choose_rev.tcl
@@ -0,0 +1,627 @@
+# git-gui revision chooser
+# Copyright (C) 2006, 2007 Shawn Pearce
+
+class choose_rev {
+
+image create photo ::choose_rev::img_find -data {R0lGODlhEAAQAIYAAPwCBCQmJDw+PBQSFAQCBMza3NTm5MTW1HyChOT29Ozq7MTq7Kze5Kzm7Oz6/NTy9Iza5GzGzKzS1Nzy9Nz29Kzq9HTGzHTK1Lza3AwKDLzu9JTi7HTW5GTCzITO1Mzq7Hza5FTK1ESyvHzKzKzW3DQyNDyqtDw6PIzW5HzGzAT+/Dw+RKyurNTOzMTGxMS+tJSGdATCxHRydLSqpLymnLSijBweHERCRNze3Pz69PTy9Oze1OTSxOTGrMSqlLy+vPTu5OzSvMymjNTGvNS+tMy2pMyunMSefAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAe4gACCAAECA4OIiAIEBQYHBAKJgwIICQoLDA0IkZIECQ4PCxARCwSSAxITFA8VEBYXGBmJAQYLGhUbHB0eH7KIGRIMEBAgISIjJKaIJQQLFxERIialkieUGigpKRoIBCqJKyyLBwvJAioEyoICLS4v6QQwMQQyLuqLli8zNDU2BCf1lN3AkUPHDh49fAQAAEnGD1MCCALZEaSHkIUMBQS8wWMIkSJGhBzBmFEGgRsBUqpMiSgdAD+BAAAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7}
+
+field w ; # our megawidget path
+field w_list ; # list of currently filtered specs
+field w_filter ; # filter entry for $w_list
+
+field c_expr {}; # current revision expression
+field filter ; # current filter string
+field revtype head; # type of revision chosen
+field cur_specs [list]; # list of specs for $revtype
+field spec_head ; # list of all head specs
+field spec_trck ; # list of all tracking branch specs
+field spec_tag ; # list of all tag specs
+field tip_data ; # array of tip commit info by refname
+field log_last ; # array of reflog date by refname
+
+field tooltip_wm {} ; # Current tooltip toplevel, if open
+field tooltip_t {} ; # Text widget in $tooltip_wm
+field tooltip_timer {} ; # Current timer event for our tooltip
+
+proc new {path {title {}}} {
+ return [_new $path 0 $title]
+}
+
+proc new_unmerged {path {title {}}} {
+ return [_new $path 1 $title]
+}
+
+constructor _new {path unmerged_only title} {
+ global current_branch is_detached
+
+ if {![info exists ::all_remotes]} {
+ load_all_remotes
+ }
+
+ set w $path
+
+ if {$title ne {}} {
+ labelframe $w -text $title
+ } else {
+ frame $w
+ }
+ bind $w <Destroy> [cb _delete %W]
+
+ if {$is_detached} {
+ radiobutton $w.detachedhead_r \
+ -anchor w \
+ -text {This Detached Checkout} \
+ -value HEAD \
+ -variable @revtype
+ grid $w.detachedhead_r -sticky we -padx {0 5} -columnspan 2
+ }
+
+ radiobutton $w.expr_r \
+ -text {Revision Expression:} \
+ -value expr \
+ -variable @revtype
+ entry $w.expr_t \
+ -borderwidth 1 \
+ -relief sunken \
+ -width 50 \
+ -textvariable @c_expr \
+ -validate key \
+ -validatecommand [cb _validate %d %S]
+ grid $w.expr_r $w.expr_t -sticky we -padx {0 5}
+
+ frame $w.types
+ radiobutton $w.types.head_r \
+ -text {Local Branch} \
+ -value head \
+ -variable @revtype
+ pack $w.types.head_r -side left
+ radiobutton $w.types.trck_r \
+ -text {Tracking Branch} \
+ -value trck \
+ -variable @revtype
+ pack $w.types.trck_r -side left
+ radiobutton $w.types.tag_r \
+ -text {Tag} \
+ -value tag \
+ -variable @revtype
+ pack $w.types.tag_r -side left
+ set w_filter $w.types.filter
+ entry $w_filter \
+ -borderwidth 1 \
+ -relief sunken \
+ -width 12 \
+ -textvariable @filter \
+ -validate key \
+ -validatecommand [cb _filter %P]
+ pack $w_filter -side right
+ pack [label $w.types.filter_icon \
+ -image ::choose_rev::img_find \
+ ] -side right
+ grid $w.types -sticky we -padx {0 5} -columnspan 2
+
+ frame $w.list
+ set w_list $w.list.l
+ listbox $w_list \
+ -font font_diff \
+ -width 50 \
+ -height 10 \
+ -selectmode browse \
+ -exportselection false \
+ -xscrollcommand [cb _sb_set $w.list.sbx h] \
+ -yscrollcommand [cb _sb_set $w.list.sby v]
+ pack $w_list -fill both -expand 1
+ grid $w.list -sticky nswe -padx {20 5} -columnspan 2
+ bind $w_list <Any-Motion> [cb _show_tooltip @%x,%y]
+ bind $w_list <Any-Enter> [cb _hide_tooltip]
+ bind $w_list <Any-Leave> [cb _hide_tooltip]
+ bind $w_list <Destroy> [cb _hide_tooltip]
+
+ grid columnconfigure $w 1 -weight 1
+ if {$is_detached} {
+ grid rowconfigure $w 3 -weight 1
+ } else {
+ grid rowconfigure $w 2 -weight 1
+ }
+
+ trace add variable @revtype write [cb _select]
+ bind $w_filter <Key-Return> [list focus $w_list]\;break
+ bind $w_filter <Key-Down> [list focus $w_list]
+
+ set fmt list
+ append fmt { %(refname)}
+ append fmt { [list}
+ append fmt { %(objecttype)}
+ append fmt { %(objectname)}
+ append fmt { [concat %(taggername) %(authorname)]}
+ append fmt { [concat %(taggerdate) %(authordate)]}
+ append fmt { %(subject)}
+ append fmt {] [list}
+ append fmt { %(*objecttype)}
+ append fmt { %(*objectname)}
+ append fmt { %(*authorname)}
+ append fmt { %(*authordate)}
+ append fmt { %(*subject)}
+ append fmt {]}
+ set all_refn [list]
+ set fr_fd [git_read for-each-ref \
+ --tcl \
+ --sort=-taggerdate \
+ --format=$fmt \
+ refs/heads \
+ refs/remotes \
+ refs/tags \
+ ]
+ fconfigure $fr_fd -translation lf -encoding utf-8
+ while {[gets $fr_fd line] > 0} {
+ set line [eval $line]
+ if {[lindex $line 1 0] eq {tag}} {
+ if {[lindex $line 2 0] eq {commit}} {
+ set sha1 [lindex $line 2 1]
+ } else {
+ continue
+ }
+ } elseif {[lindex $line 1 0] eq {commit}} {
+ set sha1 [lindex $line 1 1]
+ } else {
+ continue
+ }
+ set refn [lindex $line 0]
+ set tip_data($refn) [lrange $line 1 end]
+ lappend cmt_refn($sha1) $refn
+ lappend all_refn $refn
+ }
+ close $fr_fd
+
+ if {$unmerged_only} {
+ set fr_fd [git_read rev-list --all ^$::HEAD]
+ while {[gets $fr_fd sha1] > 0} {
+ if {[catch {set rlst $cmt_refn($sha1)}]} continue
+ foreach refn $rlst {
+ set inc($refn) 1
+ }
+ }
+ close $fr_fd
+ } else {
+ foreach refn $all_refn {
+ set inc($refn) 1
+ }
+ }
+
+ set spec_head [list]
+ foreach name [load_all_heads] {
+ set refn refs/heads/$name
+ if {[info exists inc($refn)]} {
+ lappend spec_head [list $name $refn]
+ }
+ }
+
+ set spec_trck [list]
+ foreach spec [all_tracking_branches] {
+ set refn [lindex $spec 0]
+ if {[info exists inc($refn)]} {
+ regsub ^refs/(heads|remotes)/ $refn {} name
+ lappend spec_trck [concat $name $spec]
+ }
+ }
+
+ set spec_tag [list]
+ foreach name [load_all_tags] {
+ set refn refs/tags/$name
+ if {[info exists inc($refn)]} {
+ lappend spec_tag [list $name $refn]
+ }
+ }
+
+ if {$is_detached} { set revtype HEAD
+ } elseif {[llength $spec_head] > 0} { set revtype head
+ } elseif {[llength $spec_trck] > 0} { set revtype trck
+ } elseif {[llength $spec_tag ] > 0} { set revtype tag
+ } else { set revtype expr
+ }
+
+ if {$revtype eq {head} && $current_branch ne {}} {
+ set i 0
+ foreach spec $spec_head {
+ if {[lindex $spec 0] eq $current_branch} {
+ $w_list selection clear 0 end
+ $w_list selection set $i
+ break
+ }
+ incr i
+ }
+ }
+
+ return $this
+}
+
+method none {text} {
+ if {![winfo exists $w.none_r]} {
+ radiobutton $w.none_r \
+ -anchor w \
+ -value none \
+ -variable @revtype
+ grid $w.none_r -sticky we -padx {0 5} -columnspan 2
+ }
+ $w.none_r configure -text $text
+}
+
+method get {} {
+ switch -- $revtype {
+ head -
+ trck -
+ tag {
+ set i [$w_list curselection]
+ if {$i ne {}} {
+ return [lindex $cur_specs $i 0]
+ } else {
+ return {}
+ }
+ }
+
+ HEAD { return HEAD }
+ expr { return $c_expr }
+ none { return {} }
+ default { error "unknown type of revision" }
+ }
+}
+
+method pick_tracking_branch {} {
+ set revtype trck
+}
+
+method focus_filter {} {
+ if {[$w_filter cget -state] eq {normal}} {
+ focus $w_filter
+ }
+}
+
+method bind_listbox {event script} {
+ bind $w_list $event $script
+}
+
+method get_local_branch {} {
+ if {$revtype eq {head}} {
+ return [_expr $this]
+ } else {
+ return {}
+ }
+}
+
+method get_tracking_branch {} {
+ set i [$w_list curselection]
+ if {$i eq {} || $revtype ne {trck}} {
+ return {}
+ }
+ return [lrange [lindex $cur_specs $i] 1 end]
+}
+
+method get_commit {} {
+ set e [_expr $this]
+ if {$e eq {}} {
+ return {}
+ }
+ return [git rev-parse --verify "$e^0"]
+}
+
+method commit_or_die {} {
+ if {[catch {set new [get_commit $this]} err]} {
+
+ # Cleanup the not-so-friendly error from rev-parse.
+ #
+ regsub {^fatal:\s*} $err {} err
+ if {$err eq {Needed a single revision}} {
+ set err {}
+ }
+
+ set top [winfo toplevel $w]
+ set msg "Invalid revision: [get $this]\n\n$err"
+ tk_messageBox \
+ -icon error \
+ -type ok \
+ -title [wm title $top] \
+ -parent $top \
+ -message $msg
+ error $msg
+ }
+ return $new
+}
+
+method _expr {} {
+ switch -- $revtype {
+ head -
+ trck -
+ tag {
+ set i [$w_list curselection]
+ if {$i ne {}} {
+ return [lindex $cur_specs $i 1]
+ } else {
+ error "No revision selected."
+ }
+ }
+
+ expr {
+ if {$c_expr ne {}} {
+ return $c_expr
+ } else {
+ error "Revision expression is empty."
+ }
+ }
+ HEAD { return HEAD }
+ none { return {} }
+ default { error "unknown type of revision" }
+ }
+}
+
+method _validate {d S} {
+ if {$d == 1} {
+ if {[regexp {\s} $S]} {
+ return 0
+ }
+ if {[string length $S] > 0} {
+ set revtype expr
+ }
+ }
+ return 1
+}
+
+method _filter {P} {
+ if {[regexp {\s} $P]} {
+ return 0
+ }
+ _rebuild $this $P
+ return 1
+}
+
+method _select {args} {
+ _rebuild $this $filter
+ focus_filter $this
+}
+
+method _rebuild {pat} {
+ set ste normal
+ switch -- $revtype {
+ head { set new $spec_head }
+ trck { set new $spec_trck }
+ tag { set new $spec_tag }
+ expr -
+ HEAD -
+ none {
+ set new [list]
+ set ste disabled
+ }
+ }
+
+ if {[$w_list cget -state] eq {disabled}} {
+ $w_list configure -state normal
+ }
+ $w_list delete 0 end
+
+ if {$pat ne {}} {
+ set pat *${pat}*
+ }
+ set cur_specs [list]
+ foreach spec $new {
+ set txt [lindex $spec 0]
+ if {$pat eq {} || [string match $pat $txt]} {
+ lappend cur_specs $spec
+ $w_list insert end $txt
+ }
+ }
+ if {$cur_specs ne {}} {
+ $w_list selection clear 0 end
+ $w_list selection set 0
+ }
+
+ if {[$w_filter cget -state] ne $ste} {
+ $w_list configure -state $ste
+ $w_filter configure -state $ste
+ }
+}
+
+method _delete {current} {
+ if {$current eq $w} {
+ delete_this
+ }
+}
+
+method _sb_set {sb orient first last} {
+ set old_focus [focus -lastfor $w]
+
+ if {$first == 0 && $last == 1} {
+ if {[winfo exists $sb]} {
+ destroy $sb
+ if {$old_focus ne {}} {
+ update
+ focus $old_focus
+ }
+ }
+ return
+ }
+
+ if {![winfo exists $sb]} {
+ if {$orient eq {h}} {
+ scrollbar $sb -orient h -command [list $w_list xview]
+ pack $sb -fill x -side bottom -before $w_list
+ } else {
+ scrollbar $sb -orient v -command [list $w_list yview]
+ pack $sb -fill y -side right -before $w_list
+ }
+ if {$old_focus ne {}} {
+ update
+ focus $old_focus
+ }
+ }
+ $sb set $first $last
+}
+
+method _show_tooltip {pos} {
+ if {$tooltip_wm ne {}} {
+ _open_tooltip $this
+ } elseif {$tooltip_timer eq {}} {
+ set tooltip_timer [after 1000 [cb _open_tooltip]]
+ }
+}
+
+method _open_tooltip {} {
+ global remote_url
+
+ set tooltip_timer {}
+ set pos_x [winfo pointerx $w_list]
+ set pos_y [winfo pointery $w_list]
+ if {[winfo containing $pos_x $pos_y] ne $w_list} {
+ _hide_tooltip $this
+ return
+ }
+
+ set pos @[join [list \
+ [expr {$pos_x - [winfo rootx $w_list]}] \
+ [expr {$pos_y - [winfo rooty $w_list]}]] ,]
+ set lno [$w_list index $pos]
+ if {$lno eq {}} {
+ _hide_tooltip $this
+ return
+ }
+
+ set spec [lindex $cur_specs $lno]
+ set refn [lindex $spec 1]
+ if {$refn eq {}} {
+ _hide_tooltip $this
+ return
+ }
+
+ if {$tooltip_wm eq {}} {
+ set tooltip_wm [toplevel $w_list.tooltip -borderwidth 1]
+ wm overrideredirect $tooltip_wm 1
+ wm transient $tooltip_wm [winfo toplevel $w_list]
+ set tooltip_t $tooltip_wm.label
+ text $tooltip_t \
+ -takefocus 0 \
+ -highlightthickness 0 \
+ -relief flat \
+ -borderwidth 0 \
+ -wrap none \
+ -background lightyellow \
+ -foreground black
+ $tooltip_t tag conf section_header -font font_uibold
+ bind $tooltip_wm <Escape> [cb _hide_tooltip]
+ pack $tooltip_t
+ } else {
+ $tooltip_t conf -state normal
+ $tooltip_t delete 0.0 end
+ }
+
+ set data $tip_data($refn)
+ if {[lindex $data 0 0] eq {tag}} {
+ set tag [lindex $data 0]
+ if {[lindex $data 1 0] eq {commit}} {
+ set cmit [lindex $data 1]
+ } else {
+ set cmit {}
+ }
+ } elseif {[lindex $data 0 0] eq {commit}} {
+ set tag {}
+ set cmit [lindex $data 0]
+ }
+
+ $tooltip_t insert end [lindex $spec 0]
+ set last [_reflog_last $this [lindex $spec 1]]
+ if {$last ne {}} {
+ $tooltip_t insert end "\n"
+ $tooltip_t insert end "updated"
+ $tooltip_t insert end " $last"
+ }
+ $tooltip_t insert end "\n"
+
+ if {$tag ne {}} {
+ $tooltip_t insert end "\n"
+ $tooltip_t insert end "tag" section_header
+ $tooltip_t insert end " [lindex $tag 1]\n"
+ $tooltip_t insert end [lindex $tag 2]
+ $tooltip_t insert end " ([lindex $tag 3])\n"
+ $tooltip_t insert end [lindex $tag 4]
+ $tooltip_t insert end "\n"
+ }
+
+ if {$cmit ne {}} {
+ $tooltip_t insert end "\n"
+ $tooltip_t insert end "commit" section_header
+ $tooltip_t insert end " [lindex $cmit 1]\n"
+ $tooltip_t insert end [lindex $cmit 2]
+ $tooltip_t insert end " ([lindex $cmit 3])\n"
+ $tooltip_t insert end [lindex $cmit 4]
+ }
+
+ if {[llength $spec] > 2} {
+ $tooltip_t insert end "\n"
+ $tooltip_t insert end "remote" section_header
+ $tooltip_t insert end " [lindex $spec 2]\n"
+ $tooltip_t insert end "url"
+ $tooltip_t insert end " $remote_url([lindex $spec 2])\n"
+ $tooltip_t insert end "branch"
+ $tooltip_t insert end " [lindex $spec 3]"
+ }
+
+ $tooltip_t conf -state disabled
+ _position_tooltip $this
+}
+
+method _reflog_last {name} {
+ if {[info exists reflog_last($name)]} {
+ return reflog_last($name)
+ }
+
+ set last {}
+ if {[catch {set last [file mtime [gitdir $name]]}]
+ && ![catch {set g [open [gitdir logs $name] r]}]} {
+ fconfigure $g -translation binary
+ while {[gets $g line] >= 0} {
+ if {[regexp {> ([1-9][0-9]*) } $line line when]} {
+ set last $when
+ }
+ }
+ close $g
+ }
+
+ if {$last ne {}} {
+ set last [clock format $last -format {%a %b %e %H:%M:%S %Y}]
+ }
+ set reflog_last($name) $last
+ return $last
+}
+
+method _position_tooltip {} {
+ set max_h [lindex [split [$tooltip_t index end] .] 0]
+ set max_w 0
+ for {set i 1} {$i <= $max_h} {incr i} {
+ set c [lindex [split [$tooltip_t index "$i.0 lineend"] .] 1]
+ if {$c > $max_w} {set max_w $c}
+ }
+ $tooltip_t conf -width $max_w -height $max_h
+
+ set req_w [winfo reqwidth $tooltip_t]
+ set req_h [winfo reqheight $tooltip_t]
+ set pos_x [expr {[winfo pointerx .] + 5}]
+ set pos_y [expr {[winfo pointery .] + 10}]
+
+ set g "${req_w}x${req_h}"
+ if {$pos_x >= 0} {append g +}
+ append g $pos_x
+ if {$pos_y >= 0} {append g +}
+ append g $pos_y
+
+ wm geometry $tooltip_wm $g
+ raise $tooltip_wm
+}
+
+method _hide_tooltip {} {
+ if {$tooltip_wm ne {}} {
+ destroy $tooltip_wm
+ set tooltip_wm {}
+ }
+ if {$tooltip_timer ne {}} {
+ after cancel $tooltip_timer
+ set tooltip_timer {}
+ }
+}
+
+}
diff --git a/git-gui/lib/class.tcl b/git-gui/lib/class.tcl
index 9d298d0..24e8cec 100644
--- a/git-gui/lib/class.tcl
+++ b/git-gui/lib/class.tcl
@@ -5,7 +5,7 @@ proc class {class body} {
if {[namespace exists $class]} {
error "class $class already declared"
}
- namespace eval $class {
+ namespace eval $class "
variable __nextid 0
variable __sealed 0
variable __field_list {}
@@ -13,10 +13,9 @@ proc class {class body} {
proc cb {name args} {
upvar this this
- set args [linsert $args 0 $name $this]
- return [uplevel [list namespace code $args]]
+ concat \[list ${class}::\$name \$this\] \$args
}
- }
+ "
namespace eval $class $body
}
@@ -51,15 +50,16 @@ proc constructor {name params body} {
set mbodyc {}
append mbodyc {set this } $class
- append mbodyc {::__o[incr } $class {::__nextid]} \;
- append mbodyc {namespace eval $this {}} \;
+ append mbodyc {::__o[incr } $class {::__nextid]::__d} \;
+ append mbodyc {create_this } $class \;
+ append mbodyc {set __this [namespace qualifiers $this]} \;
if {$__field_list ne {}} {
append mbodyc {upvar #0}
foreach n $__field_list {
set n [lindex $n 0]
- append mbodyc { ${this}::} $n { } $n
- regsub -all @$n\\M $body "\${this}::$n" body
+ append mbodyc { ${__this}::} $n { } $n
+ regsub -all @$n\\M $body "\${__this}::$n" body
}
append mbodyc \;
foreach n $__field_list {
@@ -80,10 +80,12 @@ proc method {name params body {deleted {}} {del_body {}}} {
set params [linsert $params 0 this]
set mbodyc {}
+ append mbodyc {set __this [namespace qualifiers $this]} \;
+
switch $deleted {
{} {}
ifdeleted {
- append mbodyc {if {![namespace exists $this]} }
+ append mbodyc {if {![namespace exists $__this]} }
append mbodyc \{ $del_body \; return \} \;
}
default {
@@ -98,10 +100,12 @@ proc method {name params body {deleted {}} {del_body {}}} {
if { [regexp -all -- $n\\M $body] == 1
&& [regexp -all -- \\\$$n\\M $body] == 1
&& [regexp -all -- \\\$$n\\( $body] == 0} {
- regsub -all \\\$$n\\M $body "\[set \${this}::$n\]" body
+ regsub -all \
+ \\\$$n\\M $body \
+ "\[set \${__this}::$n\]" body
} else {
- append decl { ${this}::} $n { } $n
- regsub -all @$n\\M $body "\${this}::$n" body
+ append decl { ${__this}::} $n { } $n
+ regsub -all @$n\\M $body "\${__this}::$n" body
}
}
}
@@ -112,11 +116,21 @@ proc method {name params body {deleted {}} {del_body {}}} {
namespace eval $class [list proc $name $params $mbodyc]
}
+proc create_this {class} {
+ upvar this this
+ namespace eval [namespace qualifiers $this] [list proc \
+ [namespace tail $this] \
+ [list name args] \
+ "eval \[list ${class}::\$name $this\] \$args" \
+ ]
+}
+
proc delete_this {{t {}}} {
if {$t eq {}} {
upvar this this
set t $this
}
+ set t [namespace qualifiers $t]
if {[namespace exists $t]} {namespace delete $t}
}
diff --git a/git-gui/lib/commit.tcl b/git-gui/lib/commit.tcl
index e139f4d..f857a2f 100644
--- a/git-gui/lib/commit.tcl
+++ b/git-gui/lib/commit.tcl
@@ -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
@@ -37,9 +37,14 @@ You are currently in the middle of a merge that has not been fully completed. Y
set enc [string tolower [string range $line 9 end]]
}
}
- set msg [encoding convertfrom $enc [read $fd]]
- set msg [string trim $msg]
+ set msg [read $fd]
close $fd
+
+ set enc [tcl_encoding $enc]
+ if {$enc ne {}} {
+ set msg [encoding convertfrom $enc $msg]
+ }
+ set msg [string trim $msg]
} err]} {
error_popup "Error loading commit data for amend:\n\n$err"
return
@@ -58,7 +63,7 @@ You are currently in the middle of a merge that has not been fully completed. Y
$ui_comm insert end $msg
$ui_comm edit reset
$ui_comm edit modified false
- rescan {set ui_status_value {Ready.}}
+ rescan ui_ready
}
set GIT_COMMITTER_IDENT {}
@@ -108,12 +113,12 @@ proc create_new_commit {} {
$ui_comm delete 0.0 end
$ui_comm edit reset
$ui_comm edit modified false
- rescan {set ui_status_value {Ready.}}
+ rescan ui_ready
}
proc commit_tree {} {
global HEAD commit_type file_states ui_comm repo_config
- global ui_status_value pch_error
+ global pch_error
if {[committer_ident] eq {}} return
if {![lock_index update]} return
@@ -132,7 +137,7 @@ Another Git program has modified this repository since the last scan. A rescan
The rescan will be automatically started now.
}
unlock_index
- rescan {set ui_status_value {Ready.}}
+ rescan ui_ready
return
}
@@ -148,7 +153,7 @@ The rescan will be automatically started now.
U? {
error_popup "Unmerged files cannot be committed.
-File [short_path $path] has merge conflicts. You must resolve them and add the file before committing.
+File [short_path $path] has merge conflicts. You must resolve them and stage the file before committing.
"
unlock_index
return
@@ -164,7 +169,7 @@ File [short_path $path] cannot be committed by this program.
if {!$files_ready && ![string match *merge $curType]} {
info_popup {No changes to commit.
-You must add at least 1 file before you can commit.
+You must stage at least 1 file before you can commit.
}
unlock_index
return
@@ -206,22 +211,22 @@ A good commit message has the following format:
return
}
- set ui_status_value {Calling pre-commit hook...}
+ ui_status {Calling pre-commit hook...}
set pch_error {}
set fd_ph [open "| $pchook" r]
- fconfigure $fd_ph -blocking 0 -translation binary
+ fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
fileevent $fd_ph readable \
[list commit_prehook_wait $fd_ph $curHEAD $msg]
}
proc commit_prehook_wait {fd_ph curHEAD msg} {
- global pch_error ui_status_value
+ global pch_error
append pch_error [read $fd_ph]
fconfigure $fd_ph -blocking 1
if {[eof $fd_ph]} {
if {[catch {close $fd_ph}]} {
- set ui_status_value {Commit declined by pre-commit hook.}
+ ui_status {Commit declined by pre-commit hook.}
hook_failed_popup pre-commit $pch_error
unlock_index
} else {
@@ -234,25 +239,23 @@ proc commit_prehook_wait {fd_ph curHEAD msg} {
}
proc commit_writetree {curHEAD msg} {
- global ui_status_value
-
- set ui_status_value {Committing changes...}
- set fd_wt [open "| git write-tree" r]
+ ui_status {Committing changes...}
+ set fd_wt [git_read write-tree]
fileevent $fd_wt readable \
[list commit_committree $fd_wt $curHEAD $msg]
}
proc commit_committree {fd_wt curHEAD msg} {
global HEAD PARENT MERGE_HEAD commit_type
- global all_heads current_branch
- global ui_status_value ui_comm selected_commit_type
+ global current_branch
+ global ui_comm selected_commit_type
global file_states selected_paths rescan_active
global repo_config
gets $fd_wt tree_id
if {$tree_id eq {} || [catch {close $fd_wt} err]} {
error_popup "write-tree failed:\n\n$err"
- set ui_status_value {Commit failed.}
+ ui_status {Commit failed.}
unlock_index
return
}
@@ -260,7 +263,7 @@ proc commit_committree {fd_wt curHEAD msg} {
# -- Verify this wasn't an empty change.
#
if {$commit_type eq {normal}} {
- set fd_ot [open "| git cat-file commit $PARENT" r]
+ set fd_ot [git_read cat-file commit $PARENT]
fconfigure $fd_ot -encoding binary -translation lf
set old_tree [gets $fd_ot]
close $fd_ot
@@ -280,7 +283,7 @@ No files were modified by this commit and it was not a merge commit.
A rescan will be automatically started now.
}
unlock_index
- rescan {set ui_status_value {No changes to commit.}}
+ rescan {ui_status {No changes to commit.}}
return
}
}
@@ -289,11 +292,18 @@ A rescan will be automatically started now.
#
set msg_p [gitdir COMMIT_EDITMSG]
set msg_wt [open $msg_p w]
+ fconfigure $msg_wt -translation lf
if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
set enc utf-8
}
- fconfigure $msg_wt -encoding binary -translation binary
- puts -nonewline $msg_wt [encoding convertto $enc $msg]
+ set use_enc [tcl_encoding $enc]
+ if {$use_enc ne {}} {
+ fconfigure $msg_wt -encoding $use_enc
+ } else {
+ puts stderr "warning: Tcl does not support encoding '$enc'."
+ fconfigure $msg_wt -encoding utf-8
+ }
+ puts -nonewline $msg_wt $msg
close $msg_wt
# -- Create the commit.
@@ -305,7 +315,7 @@ A rescan will be automatically started now.
lappend cmd <$msg_p
if {[catch {set cmt_id [eval git $cmd]} err]} {
error_popup "commit-tree failed:\n\n$err"
- set ui_status_value {Commit failed.}
+ ui_status {Commit failed.}
unlock_index
return
}
@@ -327,7 +337,7 @@ A rescan will be automatically started now.
git update-ref -m $reflogm HEAD $cmt_id $curHEAD
} err]} {
error_popup "update-ref failed:\n\n$err"
- set ui_status_value {Commit failed.}
+ ui_status {Commit failed.}
unlock_index
return
}
@@ -342,7 +352,12 @@ A rescan will be automatically started now.
# -- Let rerere do its thing.
#
- if {[file isdirectory [gitdir rr-cache]]} {
+ if {[get_config rerere.enabled] eq {}} {
+ set rerere [file isdirectory [gitdir rr-cache]]
+ } else {
+ set rerere [is_config_true rerere.enabled]
+ }
+ if {$rerere} {
catch {git rerere}
}
@@ -364,17 +379,13 @@ A rescan will be automatically started now.
$ui_comm delete 0.0 end
$ui_comm edit reset
$ui_comm edit modified false
+ if {$::GITGUI_BCK_exists} {
+ catch {file delete [gitdir GITGUI_BCK]}
+ set ::GITGUI_BCK_exists 0
+ }
if {[is_enabled singlecommit]} do_quit
- # -- Make sure our current branch exists.
- #
- if {$commit_type eq {initial}} {
- lappend all_heads $current_branch
- set all_heads [lsort -unique $all_heads]
- populate_branch_menu
- }
-
# -- Update in memory status
#
set selected_commit_type new
@@ -416,6 +427,5 @@ A rescan will be automatically started now.
display_all_files
unlock_index
reshow_diff
- set ui_status_value \
- "Created commit [string range $cmt_id 0 7]: $subject"
+ ui_status "Created commit [string range $cmt_id 0 7]: $subject"
}
diff --git a/git-gui/lib/console.tcl b/git-gui/lib/console.tcl
index 34de5d4..6f718fb 100644
--- a/git-gui/lib/console.tcl
+++ b/git-gui/lib/console.tcl
@@ -7,6 +7,7 @@ field t_short
field t_long
field w
field console_cr
+field is_toplevel 1; # are we our own window?
constructor new {short_title long_title} {
set t_short $short_title
@@ -15,10 +16,25 @@ constructor new {short_title long_title} {
return $this
}
+constructor embed {path title} {
+ set t_short {}
+ set t_long $title
+ set w $path
+ set is_toplevel 0
+ _init $this
+ return $this
+}
+
method _init {} {
global M1B
- make_toplevel top w -autodelete 0
- wm title $top "[appname] ([reponame]): $t_short"
+
+ if {$is_toplevel} {
+ make_toplevel top w -autodelete 0
+ wm title $top "[appname] ([reponame]): $t_short"
+ } else {
+ frame $w
+ }
+
set console_cr 1.0
frame $w.m
@@ -61,31 +77,26 @@ method _init {} {
$w.m.t tag remove sel 0.0 end
"
- button $w.ok -text {Close} \
- -state disabled \
- -command "destroy $w"
- pack $w.ok -side bottom -anchor e -pady 10 -padx 10
+ if {$is_toplevel} {
+ button $w.ok -text {Close} \
+ -state disabled \
+ -command [list destroy $w]
+ pack $w.ok -side bottom -anchor e -pady 10 -padx 10
+ bind $w <Visibility> [list focus $w]
+ }
bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
- bind $w <Visibility> "focus $w"
}
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]
}
@@ -159,20 +170,32 @@ method chain {cmdlist {ok 1}} {
}
}
+method insert {txt} {
+ if {![winfo exists $w.m.t]} {_init $this}
+ $w.m.t conf -state normal
+ $w.m.t insert end "$txt\n"
+ set console_cr [$w.m.t index {end -1c}]
+ $w.m.t conf -state disabled
+}
+
method done {ok} {
if {$ok} {
if {[winfo exists $w.m.s]} {
$w.m.s conf -background green -text {Success}
- $w.ok conf -state normal
- focus $w.ok
+ if {$is_toplevel} {
+ $w.ok conf -state normal
+ focus $w.ok
+ }
}
} else {
if {![winfo exists $w.m.s]} {
_init $this
}
$w.m.s conf -background red -text {Error: Command Failed}
- $w.ok conf -state normal
- focus $w.ok
+ if {$is_toplevel} {
+ $w.ok conf -state normal
+ focus $w.ok
+ }
}
delete_this
}
diff --git a/git-gui/lib/database.tcl b/git-gui/lib/database.tcl
index 43e4a28..0657cc2 100644
--- a/git-gui/lib/database.tcl
+++ b/git-gui/lib/database.tcl
@@ -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
@@ -87,3 +87,30 @@ proc do_fsck_objects {} {
lappend cmd --strict
console::exec $w $cmd
}
+
+proc hint_gc {} {
+ set object_limit 8
+ if {[is_Windows]} {
+ set object_limit 1
+ }
+
+ set objects_current [llength [glob \
+ -directory [gitdir objects 42] \
+ -nocomplain \
+ -tails \
+ -- \
+ *]]
+
+ if {$objects_current >= $object_limit} {
+ set objects_current [expr {$objects_current * 256}]
+ set object_limit [expr {$object_limit * 256}]
+ if {[ask_popup \
+ "This repository currently has approximately $objects_current loose objects.
+
+To maintain optimal performance it is strongly recommended that you compress the database when more than $object_limit loose objects exist.
+
+Compress the database now?"] eq yes} {
+ do_gc
+ }
+ }
+}
diff --git a/git-gui/lib/diff.tcl b/git-gui/lib/diff.tcl
index 29436b5..e09e125 100644
--- a/git-gui/lib/diff.tcl
+++ b/git-gui/lib/diff.tcl
@@ -17,7 +17,7 @@ proc clear_diff {} {
}
proc reshow_diff {} {
- global ui_status_value file_states file_lists
+ global file_states file_lists
global current_diff_path current_diff_side
set p $current_diff_path
@@ -49,13 +49,13 @@ A rescan will be automatically started to find other files which may have the sa
clear_diff
display_file $path __
- rescan {set ui_status_value {Ready.}} 0
+ rescan ui_ready 0
}
proc show_diff {path w {lno {}}} {
global file_states file_lists
global is_3way_diff diff_active repo_config
- global ui_diff ui_status_value ui_index ui_workdir
+ global ui_diff ui_index ui_workdir
global current_diff_path current_diff_side current_diff_header
if {$diff_active || ![lock_index read]} return
@@ -78,7 +78,7 @@ proc show_diff {path w {lno {}}} {
set current_diff_path $path
set current_diff_side $w
set current_diff_header {}
- set ui_status_value "Loading diff of [escape_path $path]..."
+ ui_status "Loading diff of [escape_path $path]..."
# - Git won't give us the diff, there's nothing to compare to!
#
@@ -86,13 +86,14 @@ proc show_diff {path w {lno {}}} {
set max_sz [expr {128 * 1024}]
if {[catch {
set fd [open $path r]
+ fconfigure $fd -eofchar {}
set content [read $fd $max_sz]
close $fd
set sz [file size $path]
} err ]} {
set diff_active 0
unlock_index
- set ui_status_value "Unable to display [escape_path $path]"
+ ui_status "Unable to display [escape_path $path]"
error_popup "Error loading file:\n\n$err"
return
}
@@ -127,11 +128,11 @@ proc show_diff {path w {lno {}}} {
$ui_diff conf -state disabled
set diff_active 0
unlock_index
- set ui_status_value {Ready.}
+ ui_ready
return
}
- set cmd [list | git]
+ set cmd [list]
if {$w eq $ui_index} {
lappend cmd diff-index
lappend cmd --cached
@@ -154,10 +155,10 @@ 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
- set ui_status_value "Unable to display [escape_path $path]"
+ ui_status "Unable to display [escape_path $path]"
error_popup "Error loading diff:\n\n$err"
return
}
@@ -170,7 +171,7 @@ proc show_diff {path w {lno {}}} {
}
proc read_diff {fd} {
- global ui_diff ui_status_value diff_active
+ global ui_diff diff_active
global is_3way_diff current_diff_header
$ui_diff conf -state normal
@@ -256,7 +257,7 @@ proc read_diff {fd} {
close $fd
set diff_active 0
unlock_index
- set ui_status_value {Ready.}
+ ui_ready
if {[$ui_diff index end] eq {2.0}} {
handle_empty_diff
@@ -271,7 +272,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 +302,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]
diff --git a/git-gui/lib/encoding.tcl b/git-gui/lib/encoding.tcl
new file mode 100644
index 0000000..7f06b0d
--- /dev/null
+++ b/git-gui/lib/encoding.tcl
@@ -0,0 +1,276 @@
+# git-gui encoding support
+# Copyright (C) 2005 Paul Mackerras <paulus@samba.org>
+# (Copied from gitk, commit fd8ccbec4f0161)
+
+# This list of encoding names and aliases is distilled from
+# http://www.iana.org/assignments/character-sets.
+# Not all of them are supported by Tcl.
+set encoding_aliases {
+ { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
+ ISO646-US US-ASCII us IBM367 cp367 csASCII }
+ { ISO-10646-UTF-1 csISO10646UTF1 }
+ { ISO_646.basic:1983 ref csISO646basic1983 }
+ { INVARIANT csINVARIANT }
+ { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
+ { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
+ { NATS-SEFI iso-ir-8-1 csNATSSEFI }
+ { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
+ { NATS-DANO iso-ir-9-1 csNATSDANO }
+ { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
+ { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
+ { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
+ { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
+ { ISO-2022-KR csISO2022KR }
+ { EUC-KR csEUCKR }
+ { ISO-2022-JP csISO2022JP }
+ { ISO-2022-JP-2 csISO2022JP2 }
+ { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
+ csISO13JISC6220jp }
+ { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
+ { IT iso-ir-15 ISO646-IT csISO15Italian }
+ { PT iso-ir-16 ISO646-PT csISO16Portuguese }
+ { ES iso-ir-17 ISO646-ES csISO17Spanish }
+ { greek7-old iso-ir-18 csISO18Greek7Old }
+ { latin-greek iso-ir-19 csISO19LatinGreek }
+ { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
+ { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
+ { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
+ { ISO_5427 iso-ir-37 csISO5427Cyrillic }
+ { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
+ { BS_viewdata iso-ir-47 csISO47BSViewdata }
+ { INIS iso-ir-49 csISO49INIS }
+ { INIS-8 iso-ir-50 csISO50INIS8 }
+ { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
+ { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
+ { ISO_5428:1980 iso-ir-55 csISO5428Greek }
+ { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
+ { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
+ { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
+ csISO60Norwegian1 }
+ { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
+ { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
+ { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
+ { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
+ { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
+ { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
+ { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
+ { greek7 iso-ir-88 csISO88Greek7 }
+ { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
+ { iso-ir-90 csISO90 }
+ { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
+ { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
+ csISO92JISC62991984b }
+ { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
+ { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
+ { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
+ csISO95JIS62291984handadd }
+ { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
+ { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
+ { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
+ { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
+ CP819 csISOLatin1 }
+ { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
+ { T.61-7bit iso-ir-102 csISO102T617bit }
+ { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
+ { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
+ { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
+ { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
+ { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
+ { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
+ { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
+ { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
+ arabic csISOLatinArabic }
+ { ISO_8859-6-E csISO88596E ISO-8859-6-E }
+ { ISO_8859-6-I csISO88596I ISO-8859-6-I }
+ { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
+ greek greek8 csISOLatinGreek }
+ { T.101-G2 iso-ir-128 csISO128T101G2 }
+ { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
+ csISOLatinHebrew }
+ { ISO_8859-8-E csISO88598E ISO-8859-8-E }
+ { ISO_8859-8-I csISO88598I ISO-8859-8-I }
+ { CSN_369103 iso-ir-139 csISO139CSN369103 }
+ { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
+ { ISO_6937-2-add iso-ir-142 csISOTextComm }
+ { IEC_P27-1 iso-ir-143 csISO143IECP271 }
+ { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
+ csISOLatinCyrillic }
+ { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
+ { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
+ { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
+ { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
+ { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
+ { ISO_6937-2-25 iso-ir-152 csISO6937Add }
+ { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
+ { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
+ { ISO_10367-box iso-ir-155 csISO10367Box }
+ { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
+ { latin-lap lap iso-ir-158 csISO158Lap }
+ { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
+ { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
+ { us-dk csUSDK }
+ { dk-us csDKUS }
+ { JIS_X0201 X0201 csHalfWidthKatakana }
+ { KSC5636 ISO646-KR csKSC5636 }
+ { ISO-10646-UCS-2 csUnicode }
+ { ISO-10646-UCS-4 csUCS4 }
+ { DEC-MCS dec csDECMCS }
+ { hp-roman8 roman8 r8 csHPRoman8 }
+ { macintosh mac csMacintosh }
+ { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
+ csIBM037 }
+ { IBM038 EBCDIC-INT cp038 csIBM038 }
+ { IBM273 CP273 csIBM273 }
+ { IBM274 EBCDIC-BE CP274 csIBM274 }
+ { IBM275 EBCDIC-BR cp275 csIBM275 }
+ { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
+ { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
+ { IBM280 CP280 ebcdic-cp-it csIBM280 }
+ { IBM281 EBCDIC-JP-E cp281 csIBM281 }
+ { IBM284 CP284 ebcdic-cp-es csIBM284 }
+ { IBM285 CP285 ebcdic-cp-gb csIBM285 }
+ { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
+ { IBM297 cp297 ebcdic-cp-fr csIBM297 }
+ { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
+ { IBM423 cp423 ebcdic-cp-gr csIBM423 }
+ { IBM424 cp424 ebcdic-cp-he csIBM424 }
+ { IBM437 cp437 437 csPC8CodePage437 }
+ { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
+ { IBM775 cp775 csPC775Baltic }
+ { IBM850 cp850 850 csPC850Multilingual }
+ { IBM851 cp851 851 csIBM851 }
+ { IBM852 cp852 852 csPCp852 }
+ { IBM855 cp855 855 csIBM855 }
+ { IBM857 cp857 857 csIBM857 }
+ { IBM860 cp860 860 csIBM860 }
+ { IBM861 cp861 861 cp-is csIBM861 }
+ { IBM862 cp862 862 csPC862LatinHebrew }
+ { IBM863 cp863 863 csIBM863 }
+ { IBM864 cp864 csIBM864 }
+ { IBM865 cp865 865 csIBM865 }
+ { IBM866 cp866 866 csIBM866 }
+ { IBM868 CP868 cp-ar csIBM868 }
+ { IBM869 cp869 869 cp-gr csIBM869 }
+ { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
+ { IBM871 CP871 ebcdic-cp-is csIBM871 }
+ { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
+ { IBM891 cp891 csIBM891 }
+ { IBM903 cp903 csIBM903 }
+ { IBM904 cp904 904 csIBBM904 }
+ { IBM905 CP905 ebcdic-cp-tr csIBM905 }
+ { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
+ { IBM1026 CP1026 csIBM1026 }
+ { EBCDIC-AT-DE csIBMEBCDICATDE }
+ { EBCDIC-AT-DE-A csEBCDICATDEA }
+ { EBCDIC-CA-FR csEBCDICCAFR }
+ { EBCDIC-DK-NO csEBCDICDKNO }
+ { EBCDIC-DK-NO-A csEBCDICDKNOA }
+ { EBCDIC-FI-SE csEBCDICFISE }
+ { EBCDIC-FI-SE-A csEBCDICFISEA }
+ { EBCDIC-FR csEBCDICFR }
+ { EBCDIC-IT csEBCDICIT }
+ { EBCDIC-PT csEBCDICPT }
+ { EBCDIC-ES csEBCDICES }
+ { EBCDIC-ES-A csEBCDICESA }
+ { EBCDIC-ES-S csEBCDICESS }
+ { EBCDIC-UK csEBCDICUK }
+ { EBCDIC-US csEBCDICUS }
+ { UNKNOWN-8BIT csUnknown8BiT }
+ { MNEMONIC csMnemonic }
+ { MNEM csMnem }
+ { VISCII csVISCII }
+ { VIQR csVIQR }
+ { KOI8-R csKOI8R }
+ { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
+ { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
+ { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
+ { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
+ { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
+ { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
+ { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
+ { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
+ { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
+ { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
+ { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
+ { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
+ { IBM1047 IBM-1047 }
+ { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
+ { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
+ { UNICODE-1-1 csUnicode11 }
+ { CESU-8 csCESU-8 }
+ { BOCU-1 csBOCU-1 }
+ { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
+ { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
+ l8 }
+ { ISO-8859-15 ISO_8859-15 Latin-9 }
+ { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
+ { GBK CP936 MS936 windows-936 }
+ { JIS_Encoding csJISEncoding }
+ { Shift_JIS MS_Kanji csShiftJIS }
+ { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
+ EUC-JP }
+ { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
+ { ISO-10646-UCS-Basic csUnicodeASCII }
+ { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
+ { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
+ { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
+ { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
+ { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
+ { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
+ { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
+ { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
+ { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
+ { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
+ { Adobe-Standard-Encoding csAdobeStandardEncoding }
+ { Ventura-US csVenturaUS }
+ { Ventura-International csVenturaInternational }
+ { PC8-Danish-Norwegian csPC8DanishNorwegian }
+ { PC8-Turkish csPC8Turkish }
+ { IBM-Symbols csIBMSymbols }
+ { IBM-Thai csIBMThai }
+ { HP-Legal csHPLegal }
+ { HP-Pi-font csHPPiFont }
+ { HP-Math8 csHPMath8 }
+ { Adobe-Symbol-Encoding csHPPSMath }
+ { HP-DeskTop csHPDesktop }
+ { Ventura-Math csVenturaMath }
+ { Microsoft-Publishing csMicrosoftPublishing }
+ { Windows-31J csWindows31J }
+ { GB2312 csGB2312 }
+ { Big5 csBig5 }
+}
+
+proc tcl_encoding {enc} {
+ global encoding_aliases
+ set names [encoding names]
+ set lcnames [string tolower $names]
+ set enc [string tolower $enc]
+ set i [lsearch -exact $lcnames $enc]
+ if {$i < 0} {
+ # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
+ if {[regsub {^iso[-_]} $enc iso encx]} {
+ set i [lsearch -exact $lcnames $encx]
+ }
+ }
+ if {$i < 0} {
+ foreach l $encoding_aliases {
+ set ll [string tolower $l]
+ if {[lsearch -exact $ll $enc] < 0} continue
+ # look through the aliases for one that tcl knows about
+ foreach e $ll {
+ set i [lsearch -exact $lcnames $e]
+ if {$i < 0} {
+ if {[regsub {^iso[-_]} $e iso ex]} {
+ set i [lsearch -exact $lcnames $ex]
+ }
+ }
+ if {$i >= 0} break
+ }
+ break
+ }
+ }
+ if {$i >= 0} {
+ return [lindex $names $i]
+ }
+ return {}
+}
diff --git a/git-gui/lib/error.tcl b/git-gui/lib/error.tcl
index d0253ae..16a2218 100644
--- a/git-gui/lib/error.tcl
+++ b/git-gui/lib/error.tcl
@@ -51,12 +51,15 @@ proc ask_popup {msg} {
if {[reponame] ne {}} {
append title " ([reponame])"
}
- return [tk_messageBox \
- -parent . \
+ set cmd [list tk_messageBox \
-icon question \
-type yesno \
-title $title \
-message $msg]
+ if {[winfo ismapped .]} {
+ lappend cmd -parent .
+ }
+ eval $cmd
}
proc hook_failed_popup {hook msg} {
diff --git a/git-gui/lib/index.tcl b/git-gui/lib/index.tcl
index 4274285..f47f929 100644
--- a/git-gui/lib/index.tcl
+++ b/git-gui/lib/index.tcl
@@ -2,7 +2,7 @@
# Copyright (C) 2006, 2007 Shawn Pearce
proc update_indexinfo {msg pathList after} {
- global update_index_cp ui_status_value
+ global update_index_cp
if {![lock_index update]} return
@@ -12,12 +12,12 @@ proc update_indexinfo {msg pathList after} {
set batch [expr {int($totalCnt * .01) + 1}]
if {$batch > 25} {set batch 25}
- set ui_status_value [format \
+ ui_status [format \
"$msg... %i/%i files (%.2f%%)" \
$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 \
@@ -36,7 +36,7 @@ proc update_indexinfo {msg pathList after} {
}
proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
- global update_index_cp ui_status_value
+ global update_index_cp
global file_states current_diff_path
if {$update_index_cp >= $totalCnt} {
@@ -67,7 +67,7 @@ proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
display_file $path $new
}
- set ui_status_value [format \
+ ui_status [format \
"$msg... %i/%i files (%.2f%%)" \
$update_index_cp \
$totalCnt \
@@ -75,7 +75,7 @@ proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
}
proc update_index {msg pathList after} {
- global update_index_cp ui_status_value
+ global update_index_cp
if {![lock_index update]} return
@@ -85,12 +85,12 @@ proc update_index {msg pathList after} {
set batch [expr {int($totalCnt * .01) + 1}]
if {$batch > 25} {set batch 25}
- set ui_status_value [format \
+ ui_status [format \
"$msg... %i/%i files (%.2f%%)" \
$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 \
@@ -109,7 +109,7 @@ proc update_index {msg pathList after} {
}
proc write_update_index {fd pathList totalCnt batch msg after} {
- global update_index_cp ui_status_value
+ global update_index_cp
global file_states current_diff_path
if {$update_index_cp >= $totalCnt} {
@@ -144,7 +144,7 @@ proc write_update_index {fd pathList totalCnt batch msg after} {
display_file $path $new
}
- set ui_status_value [format \
+ ui_status [format \
"$msg... %i/%i files (%.2f%%)" \
$update_index_cp \
$totalCnt \
@@ -152,7 +152,7 @@ proc write_update_index {fd pathList totalCnt batch msg after} {
}
proc checkout_index {msg pathList after} {
- global update_index_cp ui_status_value
+ global update_index_cp
if {![lock_index update]} return
@@ -162,18 +162,18 @@ proc checkout_index {msg pathList after} {
set batch [expr {int($totalCnt * .01) + 1}]
if {$batch > 25} {set batch 25}
- set ui_status_value [format \
+ ui_status [format \
"$msg... %i/%i files (%.2f%%)" \
$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 \
@@ -192,7 +192,7 @@ proc checkout_index {msg pathList after} {
}
proc write_checkout_index {fd pathList totalCnt batch msg after} {
- global update_index_cp ui_status_value
+ global update_index_cp
global file_states current_diff_path
if {$update_index_cp >= $totalCnt} {
@@ -217,7 +217,7 @@ proc write_checkout_index {fd pathList totalCnt batch msg after} {
}
}
- set ui_status_value [format \
+ ui_status [format \
"$msg... %i/%i files (%.2f%%)" \
$update_index_cp \
$totalCnt \
@@ -249,7 +249,7 @@ proc unstage_helper {txt paths} {
update_indexinfo \
$txt \
$pathList \
- [concat $after {set ui_status_value {Ready.}}]
+ [concat $after [list ui_ready]]
}
}
@@ -293,7 +293,7 @@ proc add_helper {txt paths} {
update_index \
$txt \
$pathList \
- [concat $after {set ui_status_value {Ready to commit.}}]
+ [concat $after {ui_status {Ready to commit.}}]
}
}
@@ -360,7 +360,7 @@ proc revert_helper {txt paths} {
"[appname] ([reponame])" \
"Revert changes in $s?
-Any unadded changes will be permanently lost by the revert." \
+Any unstaged changes will be permanently lost by the revert." \
question \
1 \
{Do Nothing} \
@@ -370,7 +370,7 @@ Any unadded changes will be permanently lost by the revert." \
checkout_index \
$txt \
$pathList \
- [concat $after {set ui_status_value {Ready.}}]
+ [concat $after [list ui_ready]]
} else {
unlock_index
}
diff --git a/git-gui/lib/merge.tcl b/git-gui/lib/merge.tcl
index 889182f..5de0d82 100644
--- a/git-gui/lib/merge.tcl
+++ b/git-gui/lib/merge.tcl
@@ -1,9 +1,12 @@
# git-gui branch merge support
# Copyright (C) 2006, 2007 Shawn Pearce
-namespace eval merge {
+class merge {
+
+field w ; # top level window
+field w_rev ; # mega-widget to pick the revision to merge
-proc _can_merge {} {
+method _can_merge {} {
global HEAD commit_type file_states
if {[string match amend* $commit_type]} {
@@ -28,7 +31,7 @@ Another Git program has modified this repository since the last scan. A rescan
The rescan will be automatically started now.
}
unlock_index
- rescan {set ui_status_value {Ready.}}
+ rescan ui_ready
return 0
}
@@ -42,7 +45,7 @@ The rescan will be automatically started now.
File [short_path $path] has merge conflicts.
-You must resolve them, add the file, and commit to complete the current merge. Only then can you begin another merge.
+You must resolve them, stage the file, and commit to complete the current merge. Only then can you begin another merge.
"
unlock_index
return 0
@@ -63,145 +66,93 @@ You should complete the current commit before starting a merge. Doing so will h
return 1
}
-proc _refs {w list} {
- set r {}
- foreach i [$w.source.l curselection] {
- lappend r [lindex [lindex $list $i] 0]
+method _rev {} {
+ if {[catch {$w_rev commit_or_die}]} {
+ return {}
}
- return $r
+ return [$w_rev get]
}
-proc _visualize {w list} {
- set revs [_refs $w $list]
- if {$revs eq {}} return
- lappend revs --not HEAD
- do_gitk $revs
+method _visualize {} {
+ set rev [_rev $this]
+ if {$rev ne {}} {
+ do_gitk [list $rev --not HEAD]
+ }
}
-proc _start {w list} {
- global HEAD ui_status_value current_branch
+method _start {} {
+ global HEAD current_branch remote_url
- set cmd [list git merge]
- set names [_refs $w $list]
- set revcnt [llength $names]
- append cmd { } $names
-
- if {$revcnt == 0} {
+ set name [_rev $this]
+ if {$name eq {}} {
return
- } elseif {$revcnt == 1} {
- set unit branch
- } elseif {$revcnt <= 15} {
- set unit branches
-
- if {[tk_dialog \
- $w.confirm_octopus \
- [wm title $w] \
- "Use octopus merge strategy?
-
-You are merging $revcnt branches at once. This requires using the octopus merge driver, which may not succeed if there are file-level conflicts.
-" \
- question \
- 0 \
- {Cancel} \
- {Use octopus} \
- ] != 1} return
- } else {
- tk_messageBox \
- -icon error \
- -type ok \
- -title [wm title $w] \
- -parent $w \
- -message "Too many branches selected.
+ }
-You have requested to merge $revcnt branches in an octopus merge. This exceeds Git's internal limit of 15 branches per merge.
+ set spec [$w_rev get_tracking_branch]
+ set cmit [$w_rev get_commit]
-Please select fewer branches. To merge more than 15 branches, merge the branches in batches.
-"
- return
+ set fh [open [gitdir FETCH_HEAD] w]
+ fconfigure $fh -translation lf
+ if {$spec eq {}} {
+ set remote .
+ set branch $name
+ set stitle $branch
+ } else {
+ set remote $remote_url([lindex $spec 1])
+ if {[regexp {^[^:@]*@[^:]*:/} $remote]} {
+ regsub {^[^:@]*@} $remote {} remote
+ }
+ set branch [lindex $spec 2]
+ set stitle "$branch of $remote"
}
-
- set msg "Merging $current_branch, [join $names {, }]"
- set ui_status_value "$msg..."
- set cons [console::new "Merge" $msg]
- console::exec $cons $cmd \
- [namespace code [list _finish $revcnt $cons]]
+ regsub ^refs/heads/ $branch {} branch
+ puts $fh "$cmit\t\tbranch '$branch' of $remote"
+ close $fh
+
+ set cmd [list git]
+ lappend cmd merge
+ lappend cmd --strategy=recursive
+ lappend cmd [git fmt-merge-msg <[gitdir FETCH_HEAD]]
+ lappend cmd HEAD
+ lappend cmd $cmit
+
+ set msg "Merging $current_branch and $stitle"
+ ui_status "$msg..."
+ set cons [console::new "Merge" "merge $stitle"]
+ console::exec $cons $cmd [cb _finish $cons]
wm protocol $w WM_DELETE_WINDOW {}
destroy $w
}
-proc _finish {revcnt w ok} {
- console::done $w $ok
+method _finish {cons ok} {
+ console::done $cons $ok
if {$ok} {
set msg {Merge completed successfully.}
} else {
- if {$revcnt != 1} {
- info_popup "Octopus merge failed.
-
-Your merge of $revcnt branches has failed.
-
-There are file-level conflicts between the branches which must be resolved manually.
-
-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]
- fconfigure $fd -blocking 0 -translation binary
- fileevent $fd readable \
- [namespace code [list _reset_wait $fd]]
- set ui_status_value {Aborting... please wait...}
- return
- }
-
set msg {Merge failed. Conflict resolution is required.}
}
unlock_index
- rescan [list set ui_status_value $msg]
+ rescan [list ui_status $msg]
+ delete_this
}
-proc dialog {} {
+constructor dialog {} {
global current_branch
global M1B
- 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]
- fconfigure $fr_fd -translation binary
- while {[gets $fr_fd line] > 0} {
- set line [eval $line]
- set ref [lindex $line 2]
- regsub ^refs/(heads|remotes|tags)/ $ref {} ref
- set subj($ref) [lindex $line 3]
- lappend sha1([lindex $line 0]) $ref
- if {[lindex $line 1] ne {}} {
- lappend sha1([lindex $line 1]) $ref
- }
- }
- close $fr_fd
-
- set to_show {}
- set fr_fd [open "| git rev-list --all --not HEAD"]
- while {[gets $fr_fd line] > 0} {
- if {[catch {set ref $sha1($line)}]} continue
- foreach n $ref {
- lappend to_show [list $n $line]
- }
+ if {![_can_merge $this]} {
+ delete_this
+ return
}
- close $fr_fd
- set to_show [lsort -unique $to_show]
- set w .merge_setup
- toplevel $w
- wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
+ make_toplevel top w
+ wm title $top "[appname] ([reponame]): Merge"
+ if {$top ne {.}} {
+ wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
+ }
- set _visualize [namespace code [list _visualize $w $to_show]]
- set _start [namespace code [list _start $w $to_show]]
+ set _start [cb _start]
label $w.header \
-text "Merge Into $current_branch" \
@@ -209,55 +160,51 @@ proc dialog {} {
pack $w.header -side top -fill x
frame $w.buttons
- button $w.buttons.visualize -text Visualize -command $_visualize
+ button $w.buttons.visualize \
+ -text Visualize \
+ -command [cb _visualize]
pack $w.buttons.visualize -side left
- button $w.buttons.create -text Merge -command $_start
- pack $w.buttons.create -side right
+ button $w.buttons.merge \
+ -text Merge \
+ -command $_start
+ pack $w.buttons.merge -side right
button $w.buttons.cancel \
-text {Cancel} \
- -command "unlock_index;destroy $w"
+ -command [cb _cancel]
pack $w.buttons.cancel -side right -padx 5
pack $w.buttons -side bottom -fill x -pady 10 -padx 10
- labelframe $w.source -text {Source Branches}
- listbox $w.source.l \
- -height 10 \
- -width 70 \
- -font font_diff \
- -selectmode extended \
- -yscrollcommand [list $w.source.sby set]
- scrollbar $w.source.sby -command [list $w.source.l yview]
- pack $w.source.sby -side right -fill y
- pack $w.source.l -side left -fill both -expand 1
- pack $w.source -fill both -expand 1 -pady 5 -padx 5
-
- foreach ref $to_show {
- set n [lindex $ref 0]
- if {[string length $n] > 20} {
- set n "[string range $n 0 16]..."
- }
- $w.source.l insert end [format {%s %-20s %s} \
- [string range [lindex $ref 1] 0 5] \
- $n \
- $subj([lindex $ref 0])]
- }
-
- bind $w.source.l <Key-K> [list event generate %W <Shift-Key-Up>]
- bind $w.source.l <Key-J> [list event generate %W <Shift-Key-Down>]
- bind $w.source.l <Key-k> [list event generate %W <Key-Up>]
- bind $w.source.l <Key-j> [list event generate %W <Key-Down>]
- bind $w.source.l <Key-h> [list event generate %W <Key-Left>]
- bind $w.source.l <Key-l> [list event generate %W <Key-Right>]
- bind $w.source.l <Key-v> $_visualize
+ set w_rev [::choose_rev::new_unmerged $w.rev {Revision To Merge}]
+ pack $w.rev -anchor nw -fill both -expand 1 -pady 5 -padx 5
bind $w <$M1B-Key-Return> $_start
- bind $w <Visibility> "grab $w; focus $w.source.l"
- bind $w <Key-Escape> "unlock_index;destroy $w"
- wm protocol $w WM_DELETE_WINDOW "unlock_index;destroy $w"
- wm title $w "[appname] ([reponame]): Merge"
+ bind $w <Key-Return> $_start
+ bind $w <Key-Escape> [cb _cancel]
+ wm protocol $w WM_DELETE_WINDOW [cb _cancel]
+
+ bind $w.buttons.merge <Visibility> [cb _visible]
tkwait window $w
}
+method _visible {} {
+ grab $w
+ if {[is_config_true gui.matchtrackingbranch]} {
+ $w_rev pick_tracking_branch
+ }
+ $w_rev focus_filter
+}
+
+method _cancel {} {
+ wm protocol $w WM_DELETE_WINDOW {}
+ unlock_index
+ destroy $w
+ delete_this
+}
+
+}
+
+namespace eval merge {
+
proc reset_hard {} {
global HEAD commit_type file_states
@@ -272,20 +219,24 @@ You must finish amending this commit.
if {![lock_index abort]} return
if {[string match *merge* $commit_type]} {
- set op merge
+ set op_question "Abort merge?
+
+Aborting the current merge will cause *ALL* uncommitted changes to be lost.
+
+Continue with aborting the current merge?"
} else {
- set op commit
- }
+ set op_question "Reset changes?
- if {[ask_popup "Abort $op?
+Resetting the changes will cause *ALL* uncommitted changes to be lost.
-Aborting the current $op will cause *ALL* uncommitted changes to be lost.
+Continue with resetting the current changes?"
+ }
-Continue with aborting the current $op?"] eq {yes}} {
- set fd [open "| git read-tree --reset -u HEAD" r]
+ if {[ask_popup $op_question] eq {yes}} {
+ set fd [git_read --stderr read-tree --reset -u -v HEAD]
fconfigure $fd -blocking 0 -translation binary
fileevent $fd readable [namespace code [list _reset_wait $fd]]
- set ui_status_value {Aborting... please wait...}
+ $::main_status start {Aborting} {files reset}
} else {
unlock_index
}
@@ -294,9 +245,12 @@ Continue with aborting the current $op?"] eq {yes}} {
proc _reset_wait {fd} {
global ui_comm
- read $fd
+ $::main_status update_meter [read $fd]
+
+ fconfigure $fd -blocking 1
if {[eof $fd]} {
- close $fd
+ set fail [catch {close $fd} err]
+ $::main_status stop
unlock_index
$ui_comm delete 0.0 end
@@ -308,7 +262,12 @@ proc _reset_wait {fd} {
catch {file delete [gitdir MERGE_MSG]}
catch {file delete [gitdir GITGUI_MSG]}
- rescan {set ui_status_value {Abort completed. Ready.}}
+ if {$fail} {
+ warn_popup "Abort failed.\n\n$err"
+ }
+ rescan {ui_status {Abort completed. Ready.}}
+ } else {
+ fconfigure $fd -blocking 0
}
}
diff --git a/git-gui/lib/option.tcl b/git-gui/lib/option.tcl
index b29e14e..aa9f783 100644
--- a/git-gui/lib/option.tcl
+++ b/git-gui/lib/option.tcl
@@ -55,7 +55,7 @@ proc save_config {} {
}
proc do_about {} {
- global appvers copyright
+ global appvers copyright oguilib
global tcl_patchLevel tk_patchLevel
set w .about_dialog
@@ -94,6 +94,11 @@ $copyright" \
append v ", Tk version $tk_patchLevel"
}
+ set d {}
+ append d "git wrapper: $::_git\n"
+ append d "git exec dir: [gitexec]\n"
+ append d "git-gui lib: $oguilib"
+
label $w.vers \
-text $v \
-padx 5 -pady 5 \
@@ -103,6 +108,15 @@ $copyright" \
-relief solid
pack $w.vers -side top -fill x -padx 5 -pady 5
+ label $w.dirs \
+ -text $d \
+ -padx 5 -pady 5 \
+ -justify left \
+ -anchor w \
+ -borderwidth 1 \
+ -relief solid
+ pack $w.dirs -side top -fill x -padx 5 -pady 5
+
menu $w.ctxm -tearoff 0
$w.ctxm add command \
-label {Copy} \
@@ -174,8 +188,11 @@ proc do_options {} {
{b merge.summary {Summarize Merge Commits}}
{i-1..5 merge.verbosity {Merge Verbosity}}
+ {b merge.diffstat {Show Diffstat After Merge}}
{b gui.trustmtime {Trust File Modification Timestamps}}
+ {b gui.pruneduringfetch {Prune Tracking Branches During Fetch}}
+ {b gui.matchtrackingbranch {Match Tracking Branches}}
{i-0..99 gui.diffcontext {Number of Diff Context Lines}}
{t gui.newbranchtemplate {New Branch Name Template}}
} {
diff --git a/git-gui/lib/remote.tcl b/git-gui/lib/remote.tcl
index 99f353e..cf9b9d5 100644
--- a/git-gui/lib/remote.tcl
+++ b/git-gui/lib/remote.tcl
@@ -1,14 +1,13 @@
# git-gui remote management
# Copyright (C) 2006, 2007 Shawn Pearce
+set some_heads_tracking 0; # assume not
+
proc is_tracking_branch {name} {
global tracking_branches
-
- if {![catch {set info $tracking_branches($name)}]} {
- return 1
- }
- foreach t [array names tracking_branches] {
- if {[string match {*/\*} $t] && [string match $t $name]} {
+ foreach spec $tracking_branches {
+ set t [lindex $spec 0]
+ if {$t eq $name || [string match $t $name]} {
return 1
}
}
@@ -18,36 +17,54 @@ proc is_tracking_branch {name} {
proc all_tracking_branches {} {
global tracking_branches
- set all_trackings {}
- set cmd {}
- foreach name [array names tracking_branches] {
- if {[regsub {/\*$} $name {} name]} {
- lappend cmd $name
+ set all [list]
+ set pat [list]
+ set cmd [list]
+
+ foreach spec $tracking_branches {
+ set dst [lindex $spec 0]
+ if {[string range $dst end-1 end] eq {/*}} {
+ lappend pat $spec
+ lappend cmd [string range $dst 0 end-2]
} else {
- regsub ^refs/(heads|remotes)/ $name {} name
- lappend all_trackings $name
+ lappend all $spec
}
}
- if {$cmd ne {}} {
- set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
- while {[gets $fd name] > 0} {
- regsub ^refs/(heads|remotes)/ $name {} name
- lappend all_trackings $name
+ if {$pat ne {}} {
+ 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 len [string length $dst]
+ if {[string equal -length $len $dst $n]} {
+ set src [string range [lindex $spec 2] 0 end-2]
+ set spec [list \
+ $n \
+ [lindex $spec 1] \
+ $src[string range $n $len end] \
+ ]
+ lappend all $spec
+ }
+ }
}
close $fd
}
- return [lsort -unique $all_trackings]
+ return [lsort -index 0 -unique $all]
}
proc load_all_remotes {} {
global repo_config
- global all_remotes tracking_branches
+ global all_remotes tracking_branches some_heads_tracking
+ global remote_url
+ set some_heads_tracking 0
set all_remotes [list]
- array unset tracking_branches
+ set trck [list]
+ set rh_str refs/heads/
+ set rh_len [string length $rh_str]
set rm_dir [gitdir remotes]
if {[file isdirectory $rm_dir]} {
set all_remotes [glob \
@@ -60,12 +77,25 @@ proc load_all_remotes {} {
catch {
set fd [open [file join $rm_dir $name] r]
while {[gets $fd line] >= 0} {
+ if {[regexp {^URL:[ ]*(.+)$} $line line url]} {
+ set remote_url($name) $url
+ continue
+ }
if {![regexp {^Pull:[ ]*([^:]+):(.+)$} \
$line line src dst]} continue
- if {![regexp ^refs/ $dst]} {
- set dst "refs/heads/$dst"
+ if {[string index $src 0] eq {+}} {
+ set src [string range $src 1 end]
+ }
+ if {![string equal -length 5 refs/ $src]} {
+ set src $rh_str$src
}
- set tracking_branches($dst) [list $name $src]
+ if {![string equal -length 5 refs/ $dst]} {
+ set dst $rh_str$dst
+ }
+ if {[string equal -length $rh_len $rh_str $dst]} {
+ set some_heads_tracking 1
+ }
+ lappend trck [list $dst $name $src]
}
close $fd
}
@@ -75,19 +105,30 @@ proc load_all_remotes {} {
foreach line [array names repo_config remote.*.url] {
if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
lappend all_remotes $name
+ set remote_url($name) $repo_config(remote.$name.url)
if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
set fl {}
}
foreach line $fl {
if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
- if {![regexp ^refs/ $dst]} {
- set dst "refs/heads/$dst"
+ if {[string index $src 0] eq {+}} {
+ set src [string range $src 1 end]
+ }
+ if {![string equal -length 5 refs/ $src]} {
+ set src $rh_str$src
+ }
+ if {![string equal -length 5 refs/ $dst]} {
+ set dst $rh_str$dst
}
- set tracking_branches($dst) [list $name $src]
+ if {[string equal -length $rh_len $rh_str $dst]} {
+ set some_heads_tracking 1
+ }
+ lappend trck [list $dst $name $src]
}
}
+ set tracking_branches [lsort -index 0 -unique $trck]
set all_remotes [lsort -unique $all_remotes]
}
@@ -95,6 +136,7 @@ proc populate_fetch_menu {} {
global all_remotes repo_config
set m .mbar.fetch
+ set prune_list [list]
foreach r $all_remotes {
set enable 0
if {![catch {set a $repo_config(remote.$r.url)}]} {
@@ -115,11 +157,21 @@ proc populate_fetch_menu {} {
}
if {$enable} {
+ lappend prune_list $r
$m add command \
-label "Fetch from $r..." \
-command [list fetch_from $r]
}
}
+
+ if {$prune_list ne {}} {
+ $m add separator
+ }
+ foreach r $prune_list {
+ $m add command \
+ -label "Prune from $r..." \
+ -command [list prune_from $r]
+ }
}
proc populate_push_menu {} {
diff --git a/git-gui/lib/remote_branch_delete.tcl b/git-gui/lib/remote_branch_delete.tcl
new file mode 100644
index 0000000..c88a360
--- /dev/null
+++ b/git-gui/lib/remote_branch_delete.tcl
@@ -0,0 +1,347 @@
+# git-gui remote branch deleting support
+# Copyright (C) 2007 Shawn Pearce
+
+class remote_branch_delete {
+
+field w
+field head_m
+
+field urltype {url}
+field remote {}
+field url {}
+
+field checktype {head}
+field check_head {}
+
+field status {}
+field idle_id {}
+field full_list {}
+field head_list {}
+field active_ls {}
+field head_cache
+field full_cache
+field cached
+
+constructor dialog {} {
+ global all_remotes M1B
+
+ make_toplevel top w
+ wm title $top "[appname] ([reponame]): Delete Remote Branch"
+ if {$top ne {.}} {
+ wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
+ }
+
+ label $w.header -text {Delete Remote Branch} -font font_uibold
+ pack $w.header -side top -fill x
+
+ frame $w.buttons
+ button $w.buttons.delete -text Delete \
+ -default active \
+ -command [cb _delete]
+ pack $w.buttons.delete -side right
+ button $w.buttons.cancel -text {Cancel} \
+ -command [list destroy $w]
+ pack $w.buttons.cancel -side right -padx 5
+ pack $w.buttons -side bottom -fill x -pady 10 -padx 10
+
+ labelframe $w.dest -text {From Repository}
+ if {$all_remotes ne {}} {
+ radiobutton $w.dest.remote_r \
+ -text {Remote:} \
+ -value remote \
+ -variable @urltype
+ eval tk_optionMenu $w.dest.remote_m @remote $all_remotes
+ grid $w.dest.remote_r $w.dest.remote_m -sticky w
+ if {[lsearch -sorted -exact $all_remotes origin] != -1} {
+ set remote origin
+ } else {
+ set remote [lindex $all_remotes 0]
+ }
+ set urltype remote
+ trace add variable @remote write [cb _write_remote]
+ } else {
+ set urltype url
+ }
+ radiobutton $w.dest.url_r \
+ -text {Arbitrary URL:} \
+ -value url \
+ -variable @urltype
+ entry $w.dest.url_t \
+ -borderwidth 1 \
+ -relief sunken \
+ -width 50 \
+ -textvariable @url \
+ -validate key \
+ -validatecommand {
+ if {%d == 1 && [regexp {\s} %S]} {return 0}
+ return 1
+ }
+ trace add variable @url write [cb _write_url]
+ grid $w.dest.url_r $w.dest.url_t -sticky we -padx {0 5}
+ grid columnconfigure $w.dest 1 -weight 1
+ pack $w.dest -anchor nw -fill x -pady 5 -padx 5
+
+ labelframe $w.heads -text {Branches}
+ listbox $w.heads.l \
+ -height 10 \
+ -width 70 \
+ -listvariable @head_list \
+ -selectmode extended \
+ -yscrollcommand [list $w.heads.sby set]
+ scrollbar $w.heads.sby -command [list $w.heads.l yview]
+
+ frame $w.heads.footer
+ label $w.heads.footer.status \
+ -textvariable @status \
+ -anchor w \
+ -justify left
+ button $w.heads.footer.rescan \
+ -text {Rescan} \
+ -command [cb _rescan]
+ pack $w.heads.footer.status -side left -fill x
+ pack $w.heads.footer.rescan -side right
+
+ pack $w.heads.footer -side bottom -fill x
+ pack $w.heads.sby -side right -fill y
+ pack $w.heads.l -side left -fill both -expand 1
+ pack $w.heads -fill both -expand 1 -pady 5 -padx 5
+
+ labelframe $w.validate -text {Delete Only If}
+ radiobutton $w.validate.head_r \
+ -text {Merged Into:} \
+ -value head \
+ -variable @checktype
+ set head_m [tk_optionMenu $w.validate.head_m @check_head {}]
+ trace add variable @head_list write [cb _write_head_list]
+ trace add variable @check_head write [cb _write_check_head]
+ grid $w.validate.head_r $w.validate.head_m -sticky w
+ radiobutton $w.validate.always_r \
+ -text {Always (Do not perform merge checks)} \
+ -value always \
+ -variable @checktype
+ grid $w.validate.always_r -columnspan 2 -sticky w
+ grid columnconfigure $w.validate 1 -weight 1
+ pack $w.validate -anchor nw -fill x -pady 5 -padx 5
+
+ trace add variable @urltype write [cb _write_urltype]
+ _rescan $this
+
+ bind $w <Key-F5> [cb _rescan]
+ bind $w <$M1B-Key-r> [cb _rescan]
+ bind $w <$M1B-Key-R> [cb _rescan]
+ bind $w <Key-Return> [cb _delete]
+ bind $w <Key-Escape> [list destroy $w]
+ return $w
+}
+
+method _delete {} {
+ switch $urltype {
+ remote {set uri $remote}
+ url {set uri $url}
+ }
+
+ set cache $urltype:$uri
+ set crev {}
+ if {$checktype eq {head}} {
+ if {$check_head eq {}} {
+ tk_messageBox \
+ -icon error \
+ -type ok \
+ -title [wm title $w] \
+ -parent $w \
+ -message "A branch is required for 'Merged Into'."
+ return
+ }
+ set crev $full_cache("$cache\nrefs/heads/$check_head")
+ }
+
+ set not_merged [list]
+ set need_fetch 0
+ set have_selection 0
+ set push_cmd [list git push]
+ lappend push_cmd -v
+ lappend push_cmd $uri
+
+ foreach i [$w.heads.l curselection] {
+ set ref [lindex $full_list $i]
+ if {$crev ne {}} {
+ set obj $full_cache("$cache\n$ref")
+ if {[catch {set m [git merge-base $obj $crev]}]} {
+ set need_fetch 1
+ set m {}
+ }
+ if {$obj ne $m} {
+ lappend not_merged [lindex $head_list $i]
+ continue
+ }
+ }
+
+ lappend push_cmd :$ref
+ set have_selection 1
+ }
+
+ if {$not_merged ne {}} {
+ set msg "The following branches are not completely merged into $check_head:
+
+ - [join $not_merged "\n - "]"
+
+ if {$need_fetch} {
+ append msg "
+
+One or more of the merge tests failed because you have not fetched the necessary commits. Try fetching from $uri first."
+ }
+
+ tk_messageBox \
+ -icon info \
+ -type ok \
+ -title [wm title $w] \
+ -parent $w \
+ -message $msg
+ if {!$have_selection} return
+ }
+
+ if {!$have_selection} {
+ tk_messageBox \
+ -icon error \
+ -type ok \
+ -title [wm title $w] \
+ -parent $w \
+ -message "Please select one or more branches to delete."
+ return
+ }
+
+ if {[tk_messageBox \
+ -icon warning \
+ -type yesno \
+ -title [wm title $w] \
+ -parent $w \
+ -message {Recovering deleted branches is difficult.
+
+Delete the selected branches?}] ne yes} {
+ return
+ }
+
+ destroy $w
+
+ set cons [console::new \
+ "push $uri" \
+ "Deleting branches from $uri"]
+ console::exec $cons $push_cmd
+}
+
+method _rescan {{force 1}} {
+ switch $urltype {
+ remote {set uri $remote}
+ url {set uri $url}
+ }
+
+ if {$force} {
+ unset -nocomplain cached($urltype:$uri)
+ }
+
+ if {$idle_id ne {}} {
+ after cancel $idle_id
+ set idle_id {}
+ }
+
+ _load $this $urltype:$uri $uri
+}
+
+method _write_remote {args} { set urltype remote }
+method _write_url {args} { set urltype url }
+method _write_check_head {args} { set checktype head }
+
+method _write_head_list {args} {
+ $head_m delete 0 end
+ foreach abr $head_list {
+ $head_m insert end radiobutton \
+ -label $abr \
+ -value $abr \
+ -variable @check_head
+ }
+ if {[lsearch -exact -sorted $head_list $check_head] < 0} {
+ set check_head {}
+ }
+}
+
+method _write_urltype {args} {
+ if {$urltype eq {url}} {
+ if {$idle_id ne {}} {
+ after cancel $idle_id
+ }
+ _load $this none: {}
+ set idle_id [after 1000 [cb _rescan 0]]
+ } else {
+ _rescan $this 0
+ }
+}
+
+method _load {cache uri} {
+ if {$active_ls ne {}} {
+ catch {close $active_ls}
+ }
+
+ if {$uri eq {}} {
+ $w.heads.l conf -state disabled
+ set head_list [list]
+ set full_list [list]
+ set status {No repository selected.}
+ return
+ }
+
+ if {[catch {set x $cached($cache)}]} {
+ set status "Scanning $uri..."
+ $w.heads.l conf -state disabled
+ set head_list [list]
+ set full_list [list]
+ set head_cache($cache) [list]
+ set full_cache($cache) [list]
+ set active_ls [git_read ls-remote $uri]
+ fconfigure $active_ls \
+ -blocking 0 \
+ -translation lf \
+ -encoding utf-8
+ fileevent $active_ls readable [cb _read $cache $active_ls]
+ } else {
+ set status {}
+ set full_list $full_cache($cache)
+ set head_list $head_cache($cache)
+ $w.heads.l conf -state normal
+ }
+}
+
+method _read {cache fd} {
+ if {$fd ne $active_ls} {
+ catch {close $fd}
+ return
+ }
+
+ while {[gets $fd line] >= 0} {
+ if {[string match {*^{}} $line]} continue
+ if {[regexp {^([0-9a-f]{40}) (.*)$} $line _junk obj ref]} {
+ if {[regsub ^refs/heads/ $ref {} abr]} {
+ lappend head_list $abr
+ lappend head_cache($cache) $abr
+ lappend full_list $ref
+ lappend full_cache($cache) $ref
+ set full_cache("$cache\n$ref") $obj
+ }
+ }
+ }
+
+ if {[eof $fd]} {
+ if {[catch {close $fd} err]} {
+ set status $err
+ set head_list [list]
+ set full_list [list]
+ } else {
+ set status {}
+ set cached($cache) 1
+ $w.heads.l conf -state normal
+ }
+ }
+} ifdeleted {
+ catch {close $fd}
+}
+
+}
diff --git a/git-gui/lib/shortcut.tcl b/git-gui/lib/shortcut.tcl
index a0a1b7d..c36be2f 100644
--- a/git-gui/lib/shortcut.tcl
+++ b/git-gui/lib/shortcut.tcl
@@ -13,10 +13,11 @@ proc do_windows_shortcut {} {
set fn ${fn}.bat
}
if {[catch {
+ set ge [file normalize [file dirname $::_git]]
set fd [open $fn w]
puts $fd "@ECHO Entering [reponame]"
puts $fd "@ECHO Starting git-gui... please wait..."
- puts $fd "@SET PATH=[file normalize [gitexec]];%PATH%"
+ puts $fd "@SET PATH=$ge;%PATH%"
puts $fd "@SET GIT_DIR=[file normalize [gitdir]]"
puts -nonewline $fd "@\"[info nameofexecutable]\""
puts $fd " \"[file normalize $argv0]\""
@@ -53,7 +54,7 @@ proc do_cygwin_shortcut {} {
set sh [exec cygpath \
--windows \
--absolute \
- /bin/sh]
+ /bin/sh.exe]
set me [exec cygpath \
--unix \
--absolute \
@@ -62,18 +63,12 @@ proc do_cygwin_shortcut {} {
--unix \
--absolute \
[gitdir]]
- set gw [exec cygpath \
- --windows \
- --absolute \
- [file dirname [gitdir]]]
- regsub -all ' $me "'\\''" me
- regsub -all ' $gd "'\\''" gd
- puts $fd "@ECHO Entering $gw"
+ puts $fd "@ECHO Entering [reponame]"
puts $fd "@ECHO Starting git-gui... please wait..."
puts -nonewline $fd "@\"$sh\" --login -c \""
- puts -nonewline $fd "GIT_DIR='$gd'"
- puts -nonewline $fd " '$me'"
- puts $fd "&\""
+ puts -nonewline $fd "GIT_DIR=[sq $gd]"
+ puts -nonewline $fd " [sq $me]"
+ puts $fd " &\""
close $fd
} err]} {
error_popup "Cannot write script:\n\n$err"
@@ -90,6 +85,9 @@ proc do_macosx_app {} {
-initialdir [file join $env(HOME) Desktop] \
-initialfile "Git [reponame].app"]
if {$fn != {}} {
+ if {[file extension $fn] ne {.app}} {
+ set fn ${fn}.app
+ }
if {[catch {
set Contents [file join $fn Contents]
set MacOS [file join $Contents MacOS]
@@ -123,20 +121,27 @@ proc do_macosx_app {} {
close $fd
set fd [open $exe w]
- set gd [file normalize [gitdir]]
- set ep [file normalize [gitexec]]
- regsub -all ' $gd "'\\''" gd
- regsub -all ' $ep "'\\''" ep
puts $fd "#!/bin/sh"
- foreach name [array names env] {
- if {[string match GIT_* $name]} {
- regsub -all ' $env($name) "'\\''" v
- puts $fd "export $name='$v'"
+ foreach name [lsort [array names env]] {
+ set value $env($name)
+ switch -- $name {
+ GIT_DIR { set value [file normalize [gitdir]] }
+ }
+
+ switch -glob -- $name {
+ SSH_* -
+ GIT_* {
+ puts $fd "if test \"z\$$name\" = z; then"
+ puts $fd " export $name=[sq $value]"
+ puts $fd "fi &&"
+ }
}
}
- puts $fd "export PATH='$ep':\$PATH"
- puts $fd "export GIT_DIR='$gd'"
- puts $fd "exec [file normalize $argv0]"
+ puts $fd "export PATH=[sq [file dirname $::_git]]:\$PATH &&"
+ puts $fd "cd [sq [file normalize [pwd]]] &&"
+ puts $fd "exec \\"
+ puts $fd " [sq [info nameofexecutable]] \\"
+ puts $fd " [sq [file normalize $argv0]]"
close $fd
file attributes $exe -permissions u+x,g+x,o+x
diff --git a/git-gui/lib/status_bar.tcl b/git-gui/lib/status_bar.tcl
new file mode 100644
index 0000000..72a8fe1
--- /dev/null
+++ b/git-gui/lib/status_bar.tcl
@@ -0,0 +1,96 @@
+# git-gui status bar mega-widget
+# Copyright (C) 2007 Shawn Pearce
+
+class status_bar {
+
+field w ; # our own window path
+field w_l ; # text widget we draw messages into
+field w_c ; # canvas we draw a progress bar into
+field status {}; # single line of text we show
+field prefix {}; # text we format into status
+field units {}; # unit of progress
+field meter {}; # current core git progress meter (if active)
+
+constructor new {path} {
+ set w $path
+ set w_l $w.l
+ set w_c $w.c
+
+ frame $w \
+ -borderwidth 1 \
+ -relief sunken
+ label $w_l \
+ -textvariable @status \
+ -anchor w \
+ -justify left
+ pack $w_l -side left
+
+ bind $w <Destroy> [cb _delete %W]
+ return $this
+}
+
+method start {msg uds} {
+ if {[winfo exists $w_c]} {
+ $w_c coords bar 0 0 0 20
+ } else {
+ canvas $w_c \
+ -width 100 \
+ -height [expr {int([winfo reqheight $w_l] * 0.6)}] \
+ -borderwidth 1 \
+ -relief groove \
+ -highlightt 0
+ $w_c create rectangle 0 0 0 20 -tags bar -fill navy
+ pack $w_c -side right
+ }
+
+ set status $msg
+ set prefix $msg
+ set units $uds
+ set meter {}
+}
+
+method update {have total} {
+ set pdone 0
+ if {$total > 0} {
+ set pdone [expr {100 * $have / $total}]
+ }
+
+ set status [format "%s ... %i of %i %s (%2i%%)" \
+ $prefix $have $total $units $pdone]
+ $w_c coords bar 0 0 $pdone 20
+}
+
+method update_meter {buf} {
+ append meter $buf
+ set r [string last "\r" $meter]
+ if {$r == -1} {
+ return
+ }
+
+ set prior [string range $meter 0 $r]
+ set meter [string range $meter [expr {$r + 1}] end]
+ if {[regexp "\\((\\d+)/(\\d+)\\)\\s+done\r\$" $prior _j a b]} {
+ update $this $a $b
+ }
+}
+
+method stop {{msg {}}} {
+ destroy $w_c
+ if {$msg ne {}} {
+ set status $msg
+ }
+}
+
+method show {msg {test {}}} {
+ if {$test eq {} || $status eq $test} {
+ set status $msg
+ }
+}
+
+method _delete {current} {
+ if {$current eq $w} {
+ delete_this
+ }
+}
+
+}
diff --git a/git-gui/lib/transport.tcl b/git-gui/lib/transport.tcl
index c0e7d20..3a22bd4 100644
--- a/git-gui/lib/transport.tcl
+++ b/git-gui/lib/transport.tcl
@@ -5,9 +5,19 @@ proc fetch_from {remote} {
set w [console::new \
"fetch $remote" \
"Fetching new changes from $remote"]
- set cmd [list git fetch]
- lappend cmd $remote
- console::exec $w $cmd
+ set cmds [list]
+ lappend cmds [list exec git fetch $remote]
+ if {[is_config_true gui.pruneduringfetch]} {
+ lappend cmds [list exec git remote prune $remote]
+ }
+ console::chain $w $cmds
+}
+
+proc prune_from {remote} {
+ set w [console::new \
+ "remote prune $remote" \
+ "Pruning tracking branches deleted from $remote"]
+ console::exec $w [list git remote prune $remote]
}
proc push_to {remote} {
@@ -64,7 +74,7 @@ trace add variable push_remote write \
[list radio_selector push_urltype remote]
proc do_push_anywhere {} {
- global all_heads all_remotes current_branch
+ global all_remotes current_branch
global push_urltype push_remote push_url push_thin push_tags
set w .push_setup
@@ -91,7 +101,7 @@ proc do_push_anywhere {} {
-width 70 \
-selectmode extended \
-yscrollcommand [list $w.source.sby set]
- foreach h $all_heads {
+ foreach h [load_all_heads] {
$w.source.l insert end $h
if {$h eq $current_branch} {
$w.source.l select set end