git-gui: Work around bad interaction between Tcl and cmd.exe on ^{tree}

From Johannes Sixt <J.Sixt@eudaptics.com>:
> It seems that MSYS's wish does some quoting for Bourne shells,
> in particular, escape the first '{' of the "^{tree}" suffix, but
> then it uses cmd.exe to run "git rev-parse". However, cmd.exe does
> not remove the backslash, so that the resulting rev expression
> ends up in git's guts as unrecognizable garbage: rev-parse fails,
> and git-gui hickups in a way that it must be restarted.

Johannes originally submitted a patch to this section of commit.tcl
to use `git rev-parse $PARENT:`, but not all versions of Git will
accept that format.  So I'm just taking the really simple approach
here of scanning the first line of the commit to grab its tree.
About the same cost, but works everywhere.

Signed-off-by: Shawn O. Pearce <spearce@spearce.org>

GIT-VERSION-GEN

@@ -78,5 +78,3 @@ test "$VN" = "$VC" || {
 	echo >&2 "GITGUI_VERSION = $VN"
 	echo "GITGUI_VERSION = $VN" >$GVF
 }
-
-

Makefile

@@ -7,6 +7,8 @@ GIT-VERSION-FILE: .FORCE-GIT-VERSION-FILE
 	@$(SHELL_PATH) ./GIT-VERSION-GEN
 -include GIT-VERSION-FILE
 
+uname_O := $(shell sh -c 'uname -o 2>/dev/null || echo not')
+
 SCRIPT_SH = git-gui.sh
 GITGUI_BUILT_INS = git-citool
 ALL_PROGRAMS = $(GITGUI_BUILT_INS) $(patsubst %.sh,%,$(SCRIPT_SH))
@@ -58,11 +60,15 @@ exedir_SQ = $(subst ','\'',$(exedir))
 
 $(patsubst %.sh,%,$(SCRIPT_SH)) : % : %.sh
 	$(QUIET_GEN)rm -f $@ $@+ && \
+	GITGUI_RELATIVE= && \
 	if test '$(exedir_SQ)' = '$(libdir_SQ)'; then \
-		GITGUI_RELATIVE=1; \
+		if test "$(uname_O)" = Cygwin; \
+		then GITGUI_RELATIVE= ; \
+		else GITGUI_RELATIVE=1; \
+		fi; \
 	fi && \
 	sed -e '1s|#!.*/sh|#!$(SHELL_PATH_SQ)|' \
-		-e 's|^exec wish "$$0"|exec $(subst |,'\|',$(TCLTK_PATH_SQ)) "$$0"|' \
+		-e 's|^ exec wish "$$0"| exec $(subst |,'\|',$(TCLTK_PATH_SQ)) "$$0"|' \
 		-e 's/@@GITGUI_VERSION@@/$(GITGUI_VERSION)/g' \
 		-e 's|@@GITGUI_RELATIVE@@|'$$GITGUI_RELATIVE'|' \
 		-e $$GITGUI_RELATIVE's|@@GITGUI_LIBDIR@@|$(libdir_SQ)|' \

git-gui.sh

@@ -1,6 +1,12 @@
 #!/bin/sh
 # Tcl ignores the next line -*- tcl -*- \
-exec wish "$0" -- "$@"
+ if test "z$*" = zversion \
+ || test "z$*" = z--version; \
+ then \
+	echo 'git-gui version @@GITGUI_VERSION@@'; \
+	exit; \
+ fi; \
+ exec wish "$0" -- "$@"
 
 set appvers {@@GITGUI_VERSION@@}
 set copyright {
@@ -271,11 +277,6 @@ proc tk_optionMenu {w varName args} {
 ##
 ## version check
 
-if {{--version} eq $argv || {version} eq $argv} {
-	puts "git-gui version $appvers"
-	exit
-}
-
 set req_maj 1
 set req_min 5
 
@@ -471,7 +472,8 @@ proc rescan {after {honor_trustmtime 1}} {
 
 	if {![$ui_comm edit modified]
 		|| [string trim [$ui_comm get 0.0 end]] eq {}} {
-		if {[load_message GITGUI_MSG]} {
+		if {[string match amend* $commit_type]} {
+		} elseif {[load_message GITGUI_MSG]} {
 		} elseif {[load_message MERGE_MSG]} {
 		} elseif {[load_message SQUASH_MSG]} {
 		}
@@ -1040,15 +1042,17 @@ proc do_gitk {revs} {
 	#    lets us bypass using shell process on Windows systems.
 	#
 	set cmd [list [info nameofexecutable]]
-	lappend cmd [gitexec gitk]
+	set exe [gitexec gitk]
+	lappend cmd $exe
 	if {$revs ne {}} {
 		append cmd { }
 		append cmd $revs
 	}
 
-	if {[catch {eval exec $cmd &} err]} {
+	if {! [file exists $exe]} {
-		error_popup "Failed to start gitk:\n\n$err"
+		error_popup "Unable to start gitk:\n\n$exe does not exist"
 	} else {
+		eval exec $cmd &
 		set ui_status_value $starting_gitk_msg
 		after 10000 {
 			if {$ui_status_value eq $starting_gitk_msg} {
@@ -1521,7 +1525,8 @@ if {[is_enabled transport]} {
 
 	menu .mbar.push
 	.mbar.push add command -label {Push...} \
-		-command do_push_anywhere
+		-command do_push_anywhere \
+		-accelerator $M1T-P
 }
 
 if {[is_MacOSX]} {
@@ -1543,8 +1548,7 @@ if {[is_MacOSX]} {
 
 	# -- Tools Menu
 	#
-	if {[file exists /usr/local/miga/lib/gui-miga]
+	if {[is_Cygwin] && [file exists /usr/local/miga/lib/gui-miga]} {
-		&& [file exists .pvcsrc]} {
 	proc do_miga {} {
 		global ui_status_value
 		if {![lock_index update]} return
@@ -1621,7 +1625,7 @@ unset browser doc_path doc_url
 
 # -- Standard bindings
 #
-bind .   <Destroy> {if {{%W} eq {.}} do_quit}
+wm protocol . WM_DELETE_WINDOW do_quit
 bind all <$M1B-Key-q> do_quit
 bind all <$M1B-Key-Q> do_quit
 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
@@ -1818,6 +1822,10 @@ pack .vpane.lower.commarea.buttons.commit -side top -fill x
 lappend disable_on_lock \
 	{.vpane.lower.commarea.buttons.commit conf -state}
 
+button .vpane.lower.commarea.buttons.push -text {Push} \
+	-command do_push_anywhere
+pack .vpane.lower.commarea.buttons.push -side top -fill x
+
 # -- Commit Message Buffer
 #
 frame .vpane.lower.commarea.buffer
@@ -2145,10 +2153,14 @@ if {[is_enabled branch]} {
 	bind . <$M1B-Key-n> do_create_branch
 	bind . <$M1B-Key-N> do_create_branch
 }
+if {[is_enabled transport]} {
+	bind . <$M1B-Key-p> do_push_anywhere
+	bind . <$M1B-Key-P> do_push_anywhere
+}
 
-bind all <Key-F5> do_rescan
+bind .   <Key-F5>     do_rescan
-bind all <$M1B-Key-r> do_rescan
+bind .   <$M1B-Key-r> do_rescan
-bind all <$M1B-Key-R> do_rescan
+bind .   <$M1B-Key-R> do_rescan
 bind .   <$M1B-Key-s> do_signoff
 bind .   <$M1B-Key-S> do_signoff
 bind .   <$M1B-Key-i> do_add_all

lib/blame.tcl

@@ -272,6 +272,8 @@ constructor new {i_commit i_path} {
 			set cursorW %W
 			tk_popup $w.ctxm %X %Y
 		"
+		bind $i <Shift-Tab> "[list focus $w_cviewer];break"
+		bind $i <Tab>       "[list focus $w_cviewer];break"
 	}
 
 	foreach i [concat $w_columns $w_cviewer] {
@@ -287,9 +289,10 @@ constructor new {i_commit i_path} {
 		bind $i <Control-Key-f> {catch {%W yview scroll  1 pages};break}
 	}
 
+	bind $w_cviewer <Shift-Tab> "[list focus $w_file];break"
+	bind $w_cviewer <Tab>       "[list focus $w_file];break"
 	bind $w_cviewer <Button-1> [list focus $w_cviewer]
-	bind $top <Visibility> [list focus $top]
+	bind $w_file    <Visibility> [list focus $w_file]
-	bind $w_file <Destroy> [list delete_this $this]
 
 	grid configure $w.header -sticky ew
 	grid configure $w.file_pane -sticky nsew
@@ -484,7 +487,11 @@ method _read_file {fd jump} {
 } ifdeleted { catch {close $fd} }
 
 method _exec_blame {cur_w cur_d options cur_s} {
-	set cmd [list nice git blame]
+	set cmd [list]
+	if {![is_Windows] || [is_Cygwin]} {
+		lappend cmd nice
+	}
+	lappend cmd git blame
 	set cmd [concat $cmd $options]
 	lappend cmd --incremental
 	if {$commit eq {}} {
@@ -540,6 +547,10 @@ method _read_blame {fd cur_w cur_d cur_s} {
 			set a_name {}
 			catch {set a_name $header($cmit,author)}
 			while {$a_name ne {}} {
+				if {$author_abbr ne {}
+					&& [string index $a_name 0] eq {'}} {
+					regsub {^'[^']+'\s+} $a_name {} a_name
+				}
 				if {![regexp {^([[:upper:]])} $a_name _a]} break
 				append author_abbr $_a
 				unset _a

lib/browser.tcl

@@ -11,6 +11,8 @@ field browser_status {Starting...}
 field browser_stack  {}
 field browser_busy   1
 
+field ls_buf     {}; # Buffered record output from ls-tree
+
 constructor new {commit} {
 	global cursor_ptr M1B
 	make_toplevel top w
@@ -70,7 +72,6 @@ constructor new {commit} {
 	bind $w_list <Right>           break
 
 	bind $w_list <Visibility> [list focus $w_list]
-	bind $w_list <Destroy> [list delete_this $this]
 	set w $w_list
 	_ls $this $browser_commit
 	return $this
@@ -161,7 +162,7 @@ method _click {was_double_click pos} {
 }
 
 method _ls {tree_id {name {}}} {
-	set browser_buffer {}
+	set ls_buf {}
 	set browser_files {}
 	set browser_busy 1
 
@@ -186,17 +187,19 @@ method _ls {tree_id {name {}}} {
 }
 
 method _read {fd} {
-	append browser_buffer [read $fd]
+	append ls_buf [read $fd]
-	set pck [split $browser_buffer "\0"]
+	set pck [split $ls_buf "\0"]
-	set browser_buffer [lindex $pck end]
+	set ls_buf [lindex $pck end]
 
 	set n [llength $browser_files]
 	$w conf -state normal
 	foreach p [lrange $pck 0 end-1] {
-		set info [split $p "\t"]
+		set tab [string first "\t" $p]
-		set path [lindex $info 1]
+		if {$tab == -1} continue
-		set info [split [lindex $info 0] { }]
+
-		set type [lindex $info 1]
+		set info [split [string range $p 0 [expr {$tab - 1}]] { }]
+		set path [string range $p [expr {$tab + 1}] end]
+		set type   [lindex $info 1]
 		set object [lindex $info 2]
 
 		switch -- $type {
@@ -226,7 +229,7 @@ method _read {fd} {
 		close $fd
 		set browser_status Ready.
 		set browser_busy 0
-		unset browser_buffer
+		set ls_buf {}
 		if {$n > 0} {
 			$w tag add in_sel 1.0 2.0
 			focus -force $w

lib/class.tcl

@@ -120,10 +120,21 @@ proc delete_this {{t {}}} {
 	if {[namespace exists $t]} {namespace delete $t}
 }
 
-proc make_toplevel {t w} {
+proc make_toplevel {t w args} {
-	upvar $t top $w pfx
+	upvar $t top $w pfx this this
+
+	if {[llength $args] % 2} {
+		error "make_toplevel topvar winvar {options}"
+	}
+	set autodelete 1
+	foreach {name value} $args {
+		switch -exact -- $name {
+		-autodelete {set autodelete $value}
+		default     {error "unsupported option $name"}
+		}
+	}
+
 	if {[winfo ismapped .]} {
-		upvar this this
 		regsub -all {::} $this {__} w
 		set top .$w
 		set pfx $top
@@ -132,6 +143,13 @@ proc make_toplevel {t w} {
 		set top .
 		set pfx {}
 	}
+
+	if {$autodelete} {
+		wm protocol $top WM_DELETE_WINDOW "
+			[list delete_this $this]
+			[list destroy $top]
+		"
+	}
 }
 
 
@@ -151,4 +169,3 @@ auto_mkindex_parser::command constructor {name args} {
 		[format { [list source [file join $dir %s]]} \
 		[file split $scriptFile]] "\n"
 }
-

lib/commit.tcl

@@ -260,7 +260,18 @@ proc commit_committree {fd_wt curHEAD msg} {
 	# -- Verify this wasn't an empty change.
 	#
 	if {$commit_type eq {normal}} {
-		set old_tree [git rev-parse "$PARENT^{tree}"]
+		set fd_ot [open "| git cat-file commit $PARENT" r]
+		fconfigure $fd_ot -encoding binary -translation lf
+		set old_tree [gets $fd_ot]
+		close $fd_ot
+
+		if {[string equal -length 5 {tree } $old_tree]
+			&& [string length $old_tree] == 45} {
+			set old_tree [string range $old_tree 5 end]
+		} else {
+			error "Commit $PARENT appears to be corrupt"
+		}
+
 		if {$tree_id eq $old_tree} {
 			info_popup {No changes to commit.
 

lib/console.tcl

@@ -17,7 +17,7 @@ constructor new {short_title long_title} {
 
 method _init {} {
 	global M1B
-	make_toplevel top w
+	make_toplevel top w -autodelete 0
 	wm title $top "[appname] ([reponame]): $t_short"
 	set console_cr 1.0
 
@@ -31,16 +31,20 @@ method _init {} {
 		-background white -borderwidth 1 \
 		-relief sunken \
 		-width 80 -height 10 \
+		-wrap none \
 		-font font_diff \
 		-state disabled \
+		-xscrollcommand [list $w.m.sbx set] \
 		-yscrollcommand [list $w.m.sby set]
 	label $w.m.s -text {Working... please wait...} \
 		-anchor w \
 		-justify left \
 		-font font_uibold
+	scrollbar $w.m.sbx -command [list $w.m.t xview] -orient h
 	scrollbar $w.m.sby -command [list $w.m.t yview]
 	pack $w.m.l1 -side top -fill x
 	pack $w.m.s -side bottom -fill x
+	pack $w.m.sbx -side bottom -fill x
 	pack $w.m.sby -side right -fill y
 	pack $w.m.t -side left -fill both -expand 1
 	pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10

lib/merge.tcl

@@ -125,7 +125,8 @@ Please select fewer branches.  To merge more than 15 branches, merge the branche
 	set cons [console::new "Merge" $msg]
 	console::exec $cons $cmd \
 		[namespace code [list _finish $revcnt $cons]]
-	bind $w <Destroy> {}
+
+	wm protocol $w WM_DELETE_WINDOW {}
 	destroy $w
 }
 
@@ -212,7 +213,9 @@ proc dialog {} {
 	pack $w.buttons.visualize -side left
 	button $w.buttons.create -text Merge -command $_start
 	pack $w.buttons.create -side right
-	button $w.buttons.cancel -text {Cancel} -command [list destroy $w]
+	button $w.buttons.cancel \
+		-text {Cancel} \
+		-command "unlock_index;destroy $w"
 	pack $w.buttons.cancel -side right -padx 5
 	pack $w.buttons -side bottom -fill x -pady 10 -padx 10
 
@@ -250,7 +253,7 @@ proc dialog {} {
 	bind $w <$M1B-Key-Return> $_start
 	bind $w <Visibility> "grab $w; focus $w.source.l"
 	bind $w <Key-Escape> "unlock_index;destroy $w"
-	bind $w <Destroy> unlock_index
+	wm protocol $w WM_DELETE_WINDOW "unlock_index;destroy $w"
 	wm title $w "[appname] ([reponame]): Merge"
 	tkwait window $w
 }

lib/shortcut.tcl

@@ -9,6 +9,9 @@ proc do_windows_shortcut {} {
 		-title "[appname] ([reponame]): Create Desktop Icon" \
 		-initialfile "Git [reponame].bat"]
 	if {$fn != {}} {
+		if {[file extension $fn] ne {.bat}} {
+			set fn ${fn}.bat
+		}
 		if {[catch {
 				set fd [open $fn w]
 				puts $fd "@ECHO Entering [reponame]"
@@ -42,6 +45,9 @@ proc do_cygwin_shortcut {} {
 		-initialdir $desktop \
 		-initialfile "Git [reponame].bat"]
 	if {$fn != {}} {
+		if {[file extension $fn] ne {.bat}} {
+			set fn ${fn}.bat
+		}
 		if {[catch {
 				set fd [open $fn w]
 				set sh [exec cygpath \