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

@@ -1,7 +1,7 @@
 #!/bin/sh
 
 GVF=GIT-VERSION-FILE
-DEF_VER=0.6.GITGUI
+DEF_VER=0.7.GITGUI
 
 LF='
 '
@@ -78,5 +78,3 @@ test "$VN" = "$VC" || {
 	echo >&2 "GITGUI_VERSION = $VN"
 	echo "GITGUI_VERSION = $VN" >$GVF
 }
-
-

Makefile

@@ -7,10 +7,13 @@ 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))
 ALL_LIBFILES = $(wildcard lib/*.tcl)
+PRELOAD_FILES = lib/class.tcl
 
 ifndef SHELL_PATH
 	SHELL_PATH = /bin/sh
@@ -21,7 +24,7 @@ ifndef gitexecdir
 endif
 
 ifndef sharedir
-	sharedir := $(dir $(gitexecdir))/share
+	sharedir := $(dir $(gitexecdir))share
 endif
 
 ifndef INSTALL
@@ -32,6 +35,7 @@ ifndef V
 	QUIET_GEN      = @echo '   ' GEN $@;
 	QUIET_BUILT_IN = @echo '   ' BUILTIN $@;
 	QUIET_INDEX    = @echo '   ' INDEX $(dir $@);
+	QUIET_2DEVNULL = 2>/dev/null
 endif
 
 TCL_PATH   ?= tclsh
@@ -45,17 +49,29 @@ endif
 DESTDIR_SQ = $(subst ','\'',$(DESTDIR))
 gitexecdir_SQ = $(subst ','\'',$(gitexecdir))
 SHELL_PATH_SQ = $(subst ','\'',$(SHELL_PATH))
+TCL_PATH_SQ = $(subst ','\'',$(TCL_PATH))
 TCLTK_PATH_SQ = $(subst ','\'',$(TCLTK_PATH))
 
 libdir   ?= $(sharedir)/git-gui/lib
 libdir_SQ = $(subst ','\'',$(libdir))
 
+exedir    = $(dir $(gitexecdir))share/git-gui/lib
+exedir_SQ = $(subst ','\'',$(exedir))
+
 $(patsubst %.sh,%,$(SCRIPT_SH)) : % : %.sh
 	$(QUIET_GEN)rm -f $@ $@+ && \
+	GITGUI_RELATIVE= && \
+	if test '$(exedir_SQ)' = '$(libdir_SQ)'; then \
+		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_LIBDIR@@|$(libdir_SQ)|' \
+		-e 's|@@GITGUI_RELATIVE@@|'$$GITGUI_RELATIVE'|' \
+		-e $$GITGUI_RELATIVE's|@@GITGUI_LIBDIR@@|$(libdir_SQ)|' \
 		$@.sh >$@+ && \
 	chmod +x $@+ && \
 	mv $@+ $@
@@ -64,14 +80,28 @@ $(GITGUI_BUILT_INS): git-gui
 	$(QUIET_BUILT_IN)rm -f $@ && ln git-gui $@
 
 lib/tclIndex: $(ALL_LIBFILES)
-	$(QUIET_INDEX)echo auto_mkindex lib '*.tcl' | $(TCL_PATH)
+	$(QUIET_INDEX)if echo \
+	  $(foreach p,$(PRELOAD_FILES),source $p\;) \
+	  auto_mkindex lib '*.tcl' \
+	| $(TCL_PATH) $(QUIET_2DEVNULL); then : ok; \
+	else \
+	 echo 1>&2 "    * $(TCL_PATH) failed; using unoptimized loading"; \
+	 rm -f $@ ; \
+	 echo '# Autogenerated by git-gui Makefile' >$@ && \
+	 echo >>$@ && \
+	 $(foreach p,$(PRELOAD_FILES) $(ALL_LIBFILES),echo '$(subst lib/,,$p)' >>$@ &&) \
+	 echo >>$@ ; \
+	fi
 
 # These can record GITGUI_VERSION
 $(patsubst %.sh,%,$(SCRIPT_SH)): GIT-VERSION-FILE GIT-GUI-VARS
+lib/tclIndex: GIT-GUI-VARS
 
 TRACK_VARS = \
 	$(subst ','\'',SHELL_PATH='$(SHELL_PATH_SQ)') \
+	$(subst ','\'',TCL_PATH='$(TCL_PATH_SQ)') \
 	$(subst ','\'',TCLTK_PATH='$(TCLTK_PATH_SQ)') \
+	$(subst ','\'',gitexecdir='$(gitexecdir_SQ)') \
 	$(subst ','\'',libdir='$(libdir_SQ)') \
 #end TRACK_VARS
 

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 {
@@ -20,15 +26,62 @@ You should have received a copy of the GNU General Public License
 along with this program; if not, write to the Free Software
 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA}
 
+######################################################################
+##
+## Tcl/Tk sanity check
+
+if {[catch {package require Tcl 8.4} err]
+ || [catch {package require Tk  8.4} err]
+} {
+	catch {wm withdraw .}
+	tk_messageBox \
+		-icon error \
+		-type ok \
+		-title "git-gui: fatal error" \
+		-message $err
+	exit 1
+}
+
 ######################################################################
 ##
 ## configure our library
 
 set oguilib {@@GITGUI_LIBDIR@@}
-if {[string match @@* $oguilib]} {
+set oguirel {@@GITGUI_RELATIVE@@}
+if {$oguirel eq {1}} {
+	set oguilib [file dirname [file dirname [file normalize $argv0]]]
+	set oguilib [file join $oguilib share git-gui lib]
+} elseif {[string match @@* $oguirel]} {
 	set oguilib [file join [file dirname [file normalize $argv0]] lib]
 }
-set auto_path [concat [list $oguilib] $auto_path]
+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
+			}
+		}
+	} 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
+	}
+	unset loaded p
+} else {
+	set auto_path [concat [list $oguilib] $auto_path]
+}
+unset -nocomplain oguilib oguirel idx fd
 
 if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
 	unset _verbose
@@ -224,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
 
@@ -261,8 +309,14 @@ unset -nocomplain v _junk act_maj act_min req_maj req_min
 ##
 ## repository setup
 
-if {   [catch {set _gitdir $env(GIT_DIR)}]
+if {[catch {
-	&& [catch {set _gitdir [git rev-parse --git-dir]} err]} {
+		set _gitdir $env(GIT_DIR)
+		set _prefix {}
+		}]
+	&& [catch {
+		set _gitdir [git rev-parse --git-dir]
+		set _prefix [git rev-parse --show-prefix]
+	} err]} {
 	catch {wm withdraw .}
 	error_popup "Cannot find the git directory:\n\n$err"
 	exit 1
@@ -418,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]} {
 		}
@@ -971,6 +1026,7 @@ proc incr_font_size {font {amt 1}} {
 	incr sz $amt
 	font configure $font -size $sz
 	font configure ${font}bold -size $sz
+	font configure ${font}italic -size $sz
 }
 
 ######################################################################
@@ -986,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} {
@@ -1163,25 +1221,24 @@ catch {
 	destroy .dummy
 }
 
+font create font_uiitalic
 font create font_uibold
 font create font_diffbold
+font create font_diffitalic
 
 foreach class {Button Checkbutton Entry Label
 		Labelframe Listbox Menu Message
-		Radiobutton Text} {
+		Radiobutton Spinbox Text} {
 	option add *$class.font font_ui
 }
 unset class
 
-if {[is_Windows]} {
+if {[is_MacOSX]} {
-	set M1B Control
-	set M1T Ctrl
-} elseif {[is_MacOSX]} {
 	set M1B M1
 	set M1T Cmd
 } else {
-	set M1B M1
+	set M1B Control
-	set M1T M1
+	set M1T Ctrl
 }
 
 proc apply_config {} {
@@ -1199,8 +1256,10 @@ proc apply_config {} {
 		}
 		foreach {cn cv} [font configure $font] {
 			font configure ${font}bold $cn $cv
+			font configure ${font}italic $cn $cv
 		}
 		font configure ${font}bold -weight bold
+		font configure ${font}italic -slant italic
 	}
 }
 
@@ -1288,7 +1347,7 @@ menu .mbar.repository
 
 .mbar.repository add command \
 	-label {Browse Current Branch} \
-	-command {new_browser $current_branch}
+	-command {browser::new $current_branch}
 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
 .mbar.repository add separator
 
@@ -1466,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]} {
@@ -1488,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
@@ -1566,31 +1625,73 @@ unset browser doc_path doc_url
 
 # -- Standard bindings
 #
-bind .   <Destroy> 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]}
 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
 
+set subcommand_args {}
+proc usage {} {
+	puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
+	exit 1
+}
+
 # -- Not a normal commit type invocation?  Do that instead!
 #
 switch -- $subcommand {
 browser {
-	if {[llength $argv] != 1} {
+	set subcommand_args {rev?}
-		puts stderr "usage: $argv0 browser commit"
+	switch [llength $argv] {
-		exit 1
+	0 {
+		set current_branch [git symbolic-ref HEAD]
+		regsub ^refs/((heads|tags|remotes)/)? \
+			$current_branch {} current_branch
 	}
-	set current_branch [lindex $argv 0]
+	1 {
-	new_browser $current_branch
+		set current_branch [lindex $argv 0]
+	}
+	default usage
+	}
+	browser::new $current_branch
 	return
 }
 blame {
-	if {[llength $argv] != 2} {
+	set subcommand_args {rev? path?}
-		puts stderr "usage: $argv0 blame commit path"
+	set head {}
-		exit 1
+	set path {}
+	set is_path 0
+	foreach a $argv {
+		if {$is_path || [file exists $_prefix$a]} {
+			if {$path ne {}} usage
+			set path $_prefix$a
+			break
+		} elseif {$a eq {--}} {
+			if {$path ne {}} {
+				if {$head ne {}} usage
+				set head $path
+				set path {}
+			}
+			set is_path 1
+		} elseif {$head eq {}} {
+			if {$head ne {}} usage
+			set head $a
+		} else {
+			usage
+		}
 	}
-	set current_branch [lindex $argv 0]
+	unset is_path
-	show_blame $current_branch [lindex $argv 1]
+
+	if {$head eq {}} {
+		set current_branch [git symbolic-ref HEAD]
+		regsub ^refs/((heads|tags|remotes)/)? \
+			$current_branch {} current_branch
+	} else {
+		set current_branch $head
+	}
+
+	if {$path eq {}} usage
+	blame::new $head $path
 	return
 }
 citool -
@@ -1638,8 +1739,8 @@ pack .vpane -anchor n -side top -fill both -expand 1
 # -- Index File List
 #
 frame .vpane.files.index -height 100 -width 200
-label .vpane.files.index.title -text {Changes To Be Committed} \
+label .vpane.files.index.title -text {Staged Changes (Will Be Committed)} \
-	-background green
+	-background lightgreen
 text $ui_index -background white -borderwidth 0 \
 	-width 20 -height 10 \
 	-wrap none \
@@ -1658,8 +1759,8 @@ pack $ui_index -side left -fill both -expand 1
 # -- Working Directory File List
 #
 frame .vpane.files.workdir -height 100 -width 200
-label .vpane.files.workdir.title -text {Changed But Not Updated} \
+label .vpane.files.workdir.title -text {Unstaged Changes (Will Not Be Committed)} \
-	-background red
+	-background lightsalmon
 text $ui_workdir -background white -borderwidth 0 \
 	-width 20 -height 10 \
 	-wrap none \
@@ -1676,10 +1777,8 @@ pack $ui_workdir -side left -fill both -expand 1
 .vpane.files add .vpane.files.workdir -sticky nsew
 
 foreach i [list $ui_index $ui_workdir] {
-	$i tag conf in_diff -font font_uibold
+	$i tag conf in_diff -background lightgray
-	$i tag conf in_sel \
+	$i tag conf in_sel  -background lightgray
-		-background [$i cget -foreground] \
-		-foreground [$i cget -background]
 }
 unset i
 
@@ -1723,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
@@ -1837,18 +1940,18 @@ proc trace_current_diff_path {varname args} {
 }
 trace add variable current_diff_path write trace_current_diff_path
 
-frame .vpane.lower.diff.header -background orange
+frame .vpane.lower.diff.header -background gold
 label .vpane.lower.diff.header.status \
-	-background orange \
+	-background gold \
 	-width $max_status_desc \
 	-anchor w \
 	-justify left
 label .vpane.lower.diff.header.file \
-	-background orange \
+	-background gold \
 	-anchor w \
 	-justify left
 label .vpane.lower.diff.header.path \
-	-background orange \
+	-background gold \
 	-anchor w \
 	-justify left
 pack .vpane.lower.diff.header.status -side left
@@ -1962,17 +2065,17 @@ lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
 $ctxm add separator
 $ctxm add command \
 	-label {Show Less Context} \
-	-command {if {$repo_config(gui.diffcontext) >= 2} {
+	-command {if {$repo_config(gui.diffcontext) >= 1} {
 		incr repo_config(gui.diffcontext) -1
 		reshow_diff
 	}}
 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
 $ctxm add command \
 	-label {Show More Context} \
-	-command {
+	-command {if {$repo_config(gui.diffcontext) < 99} {
 		incr repo_config(gui.diffcontext)
 		reshow_diff
-	}
+	}}
 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
 $ctxm add separator
 $ctxm add command -label {Options...} \
@@ -2050,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/branch.tcl

@@ -201,12 +201,14 @@ proc do_create_branch {} {
 	pack $w.desc -anchor nw -fill x -pady 5 -padx 5
 
 	labelframe $w.from -text {Starting Revision}
-	radiobutton $w.from.head_r \
+	if {$all_heads ne {}} {
-		-text {Local Branch:} \
+		radiobutton $w.from.head_r \
-		-value head \
+			-text {Local Branch:} \
-		-variable create_branch_revtype
+			-value head \
-	eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
+			-variable create_branch_revtype
-	grid $w.from.head_r $w.from.head_m -sticky w
+		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]

lib/browser.tcl

@@ -1,28 +1,28 @@
 # git-gui tree browser
 # Copyright (C) 2006, 2007 Shawn Pearce
 
-set next_browser_id 0
+class browser {
 
-proc new_browser {commit} {
+field w
-	global next_browser_id cursor_ptr M1B
+field browser_commit
-	global browser_commit browser_status browser_stack browser_path browser_busy
+field browser_path
+field browser_files  {}
+field browser_status {Starting...}
+field browser_stack  {}
+field browser_busy   1
 
-	if {[winfo ismapped .]} {
+field ls_buf     {}; # Buffered record output from ls-tree
-		set w .browser[incr next_browser_id]
-		set tl $w
-		toplevel $w
-	} else {
-		set w {}
-		set tl .
-	}
-	set w_list $w.list.l
-	set browser_commit($w_list) $commit
-	set browser_status($w_list) {Starting...}
-	set browser_stack($w_list) {}
-	set browser_path($w_list) $browser_commit($w_list):
-	set browser_busy($w_list) 1
 
-	label $w.path -textvariable browser_path($w_list) \
+constructor new {commit} {
+	global cursor_ptr M1B
+	make_toplevel top w
+	wm title $top "[appname] ([reponame]): File Browser"
+
+	set browser_commit $commit
+	set browser_path $browser_commit:
+
+	label $w.path \
+		-textvariable @browser_path \
 		-anchor w \
 		-justify left \
 		-borderwidth 1 \
@@ -31,6 +31,7 @@ proc new_browser {commit} {
 	pack $w.path -anchor w -side top -fill x
 
 	frame $w.list
+	set w_list $w.list.l
 	text $w_list -background white -borderwidth 0 \
 		-cursor $cursor_ptr \
 		-state disabled \
@@ -49,182 +50,156 @@ proc new_browser {commit} {
 	pack $w_list -side left -fill both -expand 1
 	pack $w.list -side top -fill both -expand 1
 
-	label $w.status -textvariable browser_status($w_list) \
+	label $w.status \
+		-textvariable @browser_status \
 		-anchor w \
 		-justify left \
 		-borderwidth 1 \
 		-relief sunken
 	pack $w.status -anchor w -side bottom -fill x
 
-	bind $w_list <Button-1>        "browser_click 0 $w_list @%x,%y;break"
+	bind $w_list <Button-1>        "[cb _click 0 @%x,%y];break"
-	bind $w_list <Double-Button-1> "browser_click 1 $w_list @%x,%y;break"
+	bind $w_list <Double-Button-1> "[cb _click 1 @%x,%y];break"
-	bind $w_list <$M1B-Up>         "browser_parent $w_list;break"
+	bind $w_list <$M1B-Up>         "[cb _parent]        ;break"
-	bind $w_list <$M1B-Left>       "browser_parent $w_list;break"
+	bind $w_list <$M1B-Left>       "[cb _parent]        ;break"
-	bind $w_list <Up>              "browser_move -1 $w_list;break"
+	bind $w_list <Up>              "[cb _move -1]       ;break"
-	bind $w_list <Down>            "browser_move 1 $w_list;break"
+	bind $w_list <Down>            "[cb _move  1]       ;break"
-	bind $w_list <$M1B-Right>      "browser_enter $w_list;break"
+	bind $w_list <$M1B-Right>      "[cb _enter]         ;break"
-	bind $w_list <Return>          "browser_enter $w_list;break"
+	bind $w_list <Return>          "[cb _enter]         ;break"
-	bind $w_list <Prior>           "browser_page -1 $w_list;break"
+	bind $w_list <Prior>           "[cb _page -1]       ;break"
-	bind $w_list <Next>            "browser_page 1 $w_list;break"
+	bind $w_list <Next>            "[cb _page  1]       ;break"
 	bind $w_list <Left>            break
 	bind $w_list <Right>           break
 
-	bind $tl <Visibility> "focus $w"
+	bind $w_list <Visibility> [list focus $w_list]
-	bind $tl <Destroy> "
+	set w $w_list
-		array unset browser_buffer $w_list
+	_ls $this $browser_commit
-		array unset browser_files $w_list
+	return $this
-		array unset browser_status $w_list
-		array unset browser_stack $w_list
-		array unset browser_path $w_list
-		array unset browser_commit $w_list
-		array unset browser_busy $w_list
-	"
-	wm title $tl "[appname] ([reponame]): File Browser"
-	ls_tree $w_list $browser_commit($w_list) {}
 }
 
-proc browser_move {dir w} {
+method _move {dir} {
-	global browser_files browser_busy
+	if {$browser_busy} return
-
-	if {$browser_busy($w)} return
 	set lno [lindex [split [$w index in_sel.first] .] 0]
 	incr lno $dir
-	if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
+	if {[lindex $browser_files [expr {$lno - 1}]] ne {}} {
 		$w tag remove in_sel 0.0 end
 		$w tag add in_sel $lno.0 [expr {$lno + 1}].0
 		$w see $lno.0
 	}
 }
 
-proc browser_page {dir w} {
+method _page {dir} {
-	global browser_files browser_busy
+	if {$browser_busy} return
-
-	if {$browser_busy($w)} return
 	$w yview scroll $dir pages
 	set lno [expr {int(
 		  [lindex [$w yview] 0]
-		* [llength $browser_files($w)]
+		* [llength $browser_files]
 		+ 1)}]
-	if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
+	if {[lindex $browser_files [expr {$lno - 1}]] ne {}} {
 		$w tag remove in_sel 0.0 end
 		$w tag add in_sel $lno.0 [expr {$lno + 1}].0
 		$w see $lno.0
 	}
 }
 
-proc browser_parent {w} {
+method _parent {} {
-	global browser_files browser_status browser_path
+	if {$browser_busy} return
-	global browser_stack browser_busy
+	set info [lindex $browser_files 0]
-
-	if {$browser_busy($w)} return
-	set info [lindex $browser_files($w) 0]
 	if {[lindex $info 0] eq {parent}} {
-		set parent [lindex $browser_stack($w) end-1]
+		set parent [lindex $browser_stack end-1]
-		set browser_stack($w) [lrange $browser_stack($w) 0 end-2]
+		set browser_stack [lrange $browser_stack 0 end-2]
-		if {$browser_stack($w) eq {}} {
+		if {$browser_stack eq {}} {
-			regsub {:.*$} $browser_path($w) {:} browser_path($w)
+			regsub {:.*$} $browser_path {:} browser_path
 		} else {
-			regsub {/[^/]+$} $browser_path($w) {} browser_path($w)
+			regsub {/[^/]+$} $browser_path {} browser_path
 		}
-		set browser_status($w) "Loading $browser_path($w)..."
+		set browser_status "Loading $browser_path..."
-		ls_tree $w [lindex $parent 0] [lindex $parent 1]
+		_ls $this [lindex $parent 0] [lindex $parent 1]
 	}
 }
 
-proc browser_enter {w} {
+method _enter {} {
-	global browser_files browser_status browser_path
+	if {$browser_busy} return
-	global browser_commit browser_stack browser_busy
-
-	if {$browser_busy($w)} return
 	set lno [lindex [split [$w index in_sel.first] .] 0]
-	set info [lindex $browser_files($w) [expr {$lno - 1}]]
+	set info [lindex $browser_files [expr {$lno - 1}]]
 	if {$info ne {}} {
 		switch -- [lindex $info 0] {
 		parent {
-			browser_parent $w
+			_parent $this
 		}
 		tree {
 			set name [lindex $info 2]
 			set escn [escape_path $name]
-			set browser_status($w) "Loading $escn..."
+			set browser_status "Loading $escn..."
-			append browser_path($w) $escn
+			append browser_path $escn
-			ls_tree $w [lindex $info 1] $name
+			_ls $this [lindex $info 1] $name
 		}
 		blob {
 			set name [lindex $info 2]
 			set p {}
-			foreach n $browser_stack($w) {
+			foreach n $browser_stack {
 				append p [lindex $n 1]
 			}
 			append p $name
-			show_blame $browser_commit($w) $p
+			blame::new $browser_commit $p
 		}
 		}
 	}
 }
 
-proc browser_click {was_double_click w pos} {
+method _click {was_double_click pos} {
-	global browser_files browser_busy
+	if {$browser_busy} return
-
-	if {$browser_busy($w)} return
 	set lno [lindex [split [$w index $pos] .] 0]
 	focus $w
 
-	if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
+	if {[lindex $browser_files [expr {$lno - 1}]] ne {}} {
 		$w tag remove in_sel 0.0 end
 		$w tag add in_sel $lno.0 [expr {$lno + 1}].0
 		if {$was_double_click} {
-			browser_enter $w
+			_enter $this
 		}
 	}
 }
 
-proc ls_tree {w tree_id name} {
+method _ls {tree_id {name {}}} {
-	global browser_buffer browser_files browser_stack browser_busy
+	set ls_buf {}
-
+	set browser_files {}
-	set browser_buffer($w) {}
+	set browser_busy 1
-	set browser_files($w) {}
-	set browser_busy($w) 1
 
 	$w conf -state normal
 	$w tag remove in_sel 0.0 end
 	$w delete 0.0 end
-	if {$browser_stack($w) ne {}} {
+	if {$browser_stack ne {}} {
 		$w image create end \
 			-align center -padx 5 -pady 1 \
 			-name icon0 \
 			-image file_uplevel
 		$w insert end {[Up To Parent]}
-		lappend browser_files($w) parent
+		lappend browser_files parent
 	}
-	lappend browser_stack($w) [list $tree_id $name]
+	lappend browser_stack [list $tree_id $name]
 	$w conf -state disabled
 
 	set cmd [list git ls-tree -z $tree_id]
 	set fd [open "| $cmd" r]
 	fconfigure $fd -blocking 0 -translation binary -encoding binary
-	fileevent $fd readable [list read_ls_tree $fd $w]
+	fileevent $fd readable [cb _read $fd]
 }
 
-proc read_ls_tree {fd w} {
+method _read {fd} {
-	global browser_buffer browser_files browser_status browser_busy
+	append ls_buf [read $fd]
+	set pck [split $ls_buf "\0"]
+	set ls_buf [lindex $pck end]
 
-	if {![winfo exists $w]} {
+	set n [llength $browser_files]
-		catch {close $fd}
-		return
-	}
-
-	append browser_buffer($w) [read $fd]
-	set pck [split $browser_buffer($w) "\0"]
-	set browser_buffer($w) [lindex $pck end]
-
-	set n [llength $browser_files($w)]
 	$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 {
@@ -246,18 +221,22 @@ proc read_ls_tree {fd w} {
 			-name icon[incr n] \
 			-image $image
 		$w insert end [escape_path $path]
-		lappend browser_files($w) [list $type $object $path]
+		lappend browser_files [list $type $object $path]
 	}
 	$w conf -state disabled
 
 	if {[eof $fd]} {
 		close $fd
-		set browser_status($w) Ready.
+		set browser_status Ready.
-		set browser_busy($w) 0
+		set browser_busy 0
-		array unset browser_buffer $w
+		set ls_buf {}
 		if {$n > 0} {
 			$w tag add in_sel 1.0 2.0
 			focus -force $w
 		}
 	}
+} ifdeleted {
+	catch {close $fd}
+}
+
 }

lib/class.tcl

@@ -0,0 +1,171 @@
+# git-gui simple class/object fake-alike
+# Copyright (C) 2007 Shawn Pearce
+
+proc class {class body} {
+	if {[namespace exists $class]} {
+		error "class $class already declared"
+	}
+	namespace eval $class {
+		variable __nextid     0
+		variable __sealed     0
+		variable __field_list {}
+		variable __field_array
+
+		proc cb {name args} {
+			upvar this this
+			set args [linsert $args 0 $name $this]
+			return [uplevel [list namespace code $args]]
+		}
+	}
+	namespace eval $class $body
+}
+
+proc field {name args} {
+	set class [uplevel {namespace current}]
+	variable ${class}::__sealed
+	variable ${class}::__field_array
+
+	switch [llength $args] {
+	0 { set new [list $name] }
+	1 { set new [list $name [lindex $args 0]] }
+	default { error "wrong # args: field name value?" }
+	}
+
+	if {$__sealed} {
+		error "class $class is sealed (cannot add new fields)"
+	}
+
+	if {[catch {set old $__field_array($name)}]} {
+		variable ${class}::__field_list
+		lappend __field_list $new
+		set __field_array($name) 1
+	} else {
+		error "field $name already declared"
+	}
+}
+
+proc constructor {name params body} {
+	set class [uplevel {namespace current}]
+	set ${class}::__sealed 1
+	variable ${class}::__field_list
+	set mbodyc {}
+
+	append mbodyc {set this } $class
+	append mbodyc {::__o[incr } $class {::__nextid]} \;
+	append mbodyc {namespace eval $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 \;
+		foreach n $__field_list {
+			if {[llength $n] == 2} {
+				append mbodyc \
+				{set } [lindex $n 0] { } [list [lindex $n 1]] \;
+			}
+		}
+	}
+	append mbodyc $body
+	namespace eval $class [list proc $name $params $mbodyc]
+}
+
+proc method {name params body {deleted {}} {del_body {}}} {
+	set class [uplevel {namespace current}]
+	set ${class}::__sealed 1
+	variable ${class}::__field_list
+	set params [linsert $params 0 this]
+	set mbodyc {}
+
+	switch $deleted {
+	{} {}
+	ifdeleted {
+		append mbodyc {if {![namespace exists $this]} }
+		append mbodyc \{ $del_body \; return \} \;
+	}
+	default {
+		error "wrong # args: method name args body (ifdeleted body)?"
+	}
+	}
+
+	set decl {}
+	foreach n $__field_list {
+		set n [lindex $n 0]
+		if {[regexp -- $n\\M $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
+			} else {
+				append decl { ${this}::} $n { } $n
+				regsub -all @$n\\M $body "\${this}::$n" body
+			}
+		}
+	}
+	if {$decl ne {}} {
+		append mbodyc {upvar #0} $decl \;
+	}
+	append mbodyc $body
+	namespace eval $class [list proc $name $params $mbodyc]
+}
+
+proc delete_this {{t {}}} {
+	if {$t eq {}} {
+		upvar this this
+		set t $this
+	}
+	if {[namespace exists $t]} {namespace delete $t}
+}
+
+proc make_toplevel {t w args} {
+	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 .]} {
+		regsub -all {::} $this {__} w
+		set top .$w
+		set pfx $top
+		toplevel $top
+	} else {
+		set top .
+		set pfx {}
+	}
+
+	if {$autodelete} {
+		wm protocol $top WM_DELETE_WINDOW "
+			[list delete_this $this]
+			[list destroy $top]
+		"
+	}
+}
+
+
+## auto_mkindex support for class/constructor/method
+##
+auto_mkindex_parser::command class {name body} {
+	variable parser
+	variable contextStack
+	set contextStack [linsert $contextStack 0 $name]
+	$parser eval [list _%@namespace eval $name] $body
+	set contextStack [lrange $contextStack 1 end]
+}
+auto_mkindex_parser::command constructor {name args} {
+	variable index
+	variable scriptFile
+	append index [list set auto_index([fullname $name])] \
+		[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

@@ -1,30 +1,29 @@
 # git-gui console support
 # Copyright (C) 2006, 2007 Shawn Pearce
 
-namespace eval console {
+class console {
 
-variable next_console_id 0
+field t_short
-variable console_data
+field t_long
-variable console_cr
+field w
+field console_cr
 
-proc new {short_title long_title} {
+constructor new {short_title long_title} {
-	variable next_console_id
+	set t_short $short_title
-	variable console_data
+	set t_long $long_title
-
+	_init $this
-	set w .console[incr next_console_id]
+	return $this
-	set console_data($w) [list $short_title $long_title]
-	return [_init $w]
 }
 
-proc _init {w} {
+method _init {} {
 	global M1B
-	variable console_cr
+	make_toplevel top w -autodelete 0
-	variable console_data
+	wm title $top "[appname] ([reponame]): $t_short"
+	set console_cr 1.0
 
-	set console_cr($w) 1.0
-	toplevel $w
 	frame $w.m
-	label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
+	label $w.m.l1 \
+		-textvariable @t_long  \
 		-anchor w \
 		-justify left \
 		-font font_uibold
@@ -32,16 +31,20 @@ proc _init {w} {
 		-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
@@ -67,11 +70,9 @@ proc _init {w} {
 	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"
-	wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
-	return $w
 }
 
-proc exec {w cmd {after {}}} {
+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. :-(
 	#
@@ -86,16 +87,13 @@ proc exec {w cmd {after {}}} {
 
 	set fd_f [open $cmd r]
 	fconfigure $fd_f -blocking 0 -translation binary
-	fileevent $fd_f readable \
+	fileevent $fd_f readable [cb _read $fd_f $after]
-		[namespace code [list _read $w $fd_f $after]]
 }
 
-proc _read {w fd after} {
+method _read {fd after} {
-	variable console_cr
-
 	set buf [read $fd]
 	if {$buf ne {}} {
-		if {![winfo exists $w]} {_init $w}
+		if {![winfo exists $w.m.t]} {_init $this}
 		$w.m.t conf -state normal
 		set c 0
 		set n [string length $buf]
@@ -107,11 +105,11 @@ proc _read {w fd after} {
 
 			if {$lf < $cr} {
 				$w.m.t insert end [string range $buf $c $lf]
-				set console_cr($w) [$w.m.t index {end -1c}]
+				set console_cr [$w.m.t index {end -1c}]
 				set c $lf
 				incr c
 			} else {
-				$w.m.t delete $console_cr($w) end
+				$w.m.t delete $console_cr end
 				$w.m.t insert end "\n"
 				$w.m.t insert end [string range $buf $c $cr]
 				set c $cr
@@ -130,19 +128,19 @@ proc _read {w fd after} {
 			set ok 1
 		}
 		if {$after ne {}} {
-			uplevel #0 $after $w $ok
+			uplevel #0 $after $ok
 		} else {
-			done $w $ok
+			done $this $ok
 		}
 		return
 	}
 	fconfigure $fd -blocking 0
 }
 
-proc chain {cmdlist w {ok 1}} {
+method chain {cmdlist {ok 1}} {
 	if {$ok} {
 		if {[llength $cmdlist] == 0} {
-			done $w $ok
+			done $this $ok
 			return
 		}
 
@@ -150,52 +148,33 @@ proc chain {cmdlist w {ok 1}} {
 		set cmdlist [lrange $cmdlist 1 end]
 
 		if {[lindex $cmd 0] eq {exec}} {
-			exec $w \
+			exec $this \
-				[lindex $cmd 1] \
+				[lrange $cmd 1 end] \
-				[namespace code [list chain $cmdlist]]
+				[cb chain $cmdlist]
 		} else {
-			uplevel #0 $cmd $cmdlist $w $ok
+			uplevel #0 $cmd [cb chain $cmdlist]
 		}
 	} else {
-		done $w $ok
+		done $this $ok
 	}
 }
 
-proc done {args} {
+method done {ok} {
-	variable console_cr
-	variable console_data
-
-	switch -- [llength $args] {
-	2 {
-		set w [lindex $args 0]
-		set ok [lindex $args 1]
-	}
-	3 {
-		set w [lindex $args 1]
-		set ok [lindex $args 2]
-	}
-	default {
-		error "wrong number of args: done ?ignored? w ok"
-	}
-	}
-
 	if {$ok} {
-		if {[winfo exists $w]} {
+		if {[winfo exists $w.m.s]} {
 			$w.m.s conf -background green -text {Success}
 			$w.ok conf -state normal
 			focus $w.ok
 		}
 	} else {
-		if {![winfo exists $w]} {
+		if {![winfo exists $w.m.s]} {
-			_init $w
+			_init $this
 		}
 		$w.m.s conf -background red -text {Error: Command Failed}
 		$w.ok conf -state normal
 		focus $w.ok
 	}
-
+	delete_this
-	array unset console_cr $w
-	array unset console_data $w
 }
 
 }

lib/database.tcl

@@ -70,12 +70,12 @@ proc do_stats {} {
 
 proc do_gc {} {
 	set w [console::new {gc} {Compressing the object database}]
-	console::chain {
+	console::chain $w {
-		{exec {git pack-refs --prune}}
+		{exec git pack-refs --prune}
-		{exec {git reflog expire --all}}
+		{exec git reflog expire --all}
-		{exec {git repack -a -d -l}}
+		{exec git repack -a -d -l}
-		{exec {git rerere gc}}
+		{exec git rerere gc}
-	} $w
+	}
 }
 
 proc do_fsck_objects {} {

lib/diff.tcl

@@ -145,7 +145,7 @@ proc show_diff {path w {lno {}}} {
 
 	lappend cmd -p
 	lappend cmd --no-color
-	if {$repo_config(gui.diffcontext) > 0} {
+	if {$repo_config(gui.diffcontext) >= 0} {
 		lappend cmd "-U$repo_config(gui.diffcontext)"
 	}
 	if {$w eq $ui_index} {

lib/merge.tcl

@@ -123,8 +123,10 @@ Please select fewer branches.  To merge more than 15 branches, merge the branche
 	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]]
+	console::exec $cons $cmd \
-	bind $w <Destroy> {}
+		[namespace code [list _finish $revcnt $cons]]
+
+	wm protocol $w WM_DELETE_WINDOW {}
 	destroy $w
 }
 
@@ -211,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
 
@@ -238,6 +242,8 @@ proc dialog {} {
 			$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>]
@@ -247,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/option.tcl

@@ -15,6 +15,9 @@ proc save_config {} {
 		font configure ${font}bold \
 			-family $global_config_new(gui.$font^^family) \
 			-size $global_config_new(gui.$font^^size)
+		font configure ${font}italic \
+			-family $global_config_new(gui.$font^^family) \
+			-size $global_config_new(gui.$font^^size)
 		set global_config_new(gui.$name) [font configure $font]
 		unset global_config_new(gui.$font^^family)
 		unset global_config_new(gui.$font^^size)
@@ -173,7 +176,7 @@ proc do_options {} {
 		{i-1..5 merge.verbosity {Merge Verbosity}}
 
 		{b gui.trustmtime  {Trust File Modification Timestamps}}
-		{i-1..99 gui.diffcontext {Number of Diff Context Lines}}
+		{i-0..99 gui.diffcontext {Number of Diff Context Lines}}
 		{t gui.newbranchtemplate {New Branch Name Template}}
 		} {
 		set type [lindex $option 0]

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 \