git-gui: Minor refactoring of merge command line in merge support

This is just a small code movement to cleanup how we generate
the command line for a merge.  I'm only doing it to make the
next series of changes slightly more readable.

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

.gitignore

@@ -1,3 +1,5 @@
 GIT-VERSION-FILE
+GIT-GUI-VARS
 git-citool
 git-gui
+lib/tclIndex

GIT-VERSION-GEN

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

Makefile

@@ -7,9 +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
@@ -19,15 +23,48 @@ ifndef gitexecdir
 	gitexecdir := $(shell git --exec-path)
 endif
 
+ifndef sharedir
+	sharedir := $(dir $(gitexecdir))share
+endif
+
 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          = @
+	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
+TCLTK_PATH ?= wish
+
 ifeq ($(findstring $(MAKEFLAGS),s),s)
 QUIET_GEN =
 QUIET_BUILT_IN =
@@ -36,11 +73,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/@@GITGUI_VERSION@@/$(GITGUI_VERSION)/g' \
+		-e 's|@@GITGUI_RELATIVE@@|'$$GITGUI_RELATIVE'|' \
+		-e $$GITGUI_RELATIVE's|@@GITGUI_LIBDIR@@|$(libdir_SQ)|' \
 		$@.sh >$@+ && \
 	chmod +x $@+ && \
 	mv $@+ $@
@@ -48,22 +103,57 @@ $(patsubst %.sh,%,$(SCRIPT_SH)) : % : %.sh
 $(GITGUI_BUILT_INS): git-gui
 	$(QUIET_BUILT_IN)rm -f $@ && ln git-gui $@
 
-# These can record GITGUI_VERSION
-$(patsubst %.sh,%,$(SCRIPT_SH)): GIT-VERSION-FILE
+lib/tclIndex: $(ALL_LIBFILES)
+	$(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
 
-all:: $(ALL_PROGRAMS)
+# 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-VARS: .FORCE-GIT-GUI-VARS
+	@VARS='$(TRACK_VARS)'; \
+	if test x"$$VARS" != x"`cat $@ 2>/dev/null`" ; then \
+		echo 1>&2 "    * new locations or Tcl/Tk interpreter"; \
+		echo 1>$@ "$$VARS"; \
+	fi
+
+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' ;)
+	$(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)
 	@echo $(GITGUI_VERSION) > $(TARDIR)/version
 
 clean::
-	rm -f $(ALL_PROGRAMS) GIT-VERSION-FILE
+	rm -f $(ALL_PROGRAMS) lib/tclIndex
+	rm -f GIT-VERSION-FILE GIT-GUI-VARS
 
 .PHONY: all install dist-version clean
 .PHONY: .FORCE-GIT-VERSION-FILE
+.PHONY: .FORCE-GIT-GUI-VARS

lib/blame.tcl

@@ -0,0 +1,992 @@
+# git-gui blame viewer
+# Copyright (C) 2006, 2007 Shawn Pearce
+
+class blame {
+
+image create photo ::blame::img_back_arrow -data {R0lGODlhGAAYAIUAAPwCBEzKXFTSZIz+nGzmhGzqfGTidIT+nEzGXHTqhGzmfGzifFzadETCVES+VARWDFzWbHzyjAReDGTadFTOZDSyRDyyTCymPARaFGTedFzSbDy2TCyqRCyqPARaDAyCHES6VDy6VCyiPAR6HCSeNByWLARyFARiDARqFGTifARiFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAYABgAAAajQIBwSCwaj8ikcsk0BppJwRPqHEypQwHBis0WDAdEFyBIKBaMAKLBdjQeSkFBYTBAIvgEoS6JmhUTEwIUDQ4VFhcMGEhyCgoZExoUaxsWHB0THkgfAXUGAhoBDSAVFR0XBnCbDRmgog0hpSIiDJpJIyEQhBUcJCIlwA22SSYVogknEg8eD82qSigdDSknY0IqJQXPYxIl1dZCGNvWw+Dm510GQQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7}
+
+# Persistant data (survives loads)
+#
+field history {}; # viewer history: {commit path}
+field header    ; # array commit,key -> header field
+
+# Tk UI control paths
+#
+field w          ; # top window in this viewer
+field w_back     ; # our back button
+field w_path     ; # label showing the current file path
+field w_columns  ; # list of all column widgets in the viewer
+field w_line     ; # text column: all line numbers
+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     ; # status mega-widget instance
+field old_height ; # last known height of $w.file_pane
+
+# Tk UI colors
+#
+variable active_color #c0edc5
+variable group_colors {
+	#d6d6d6
+	#e1e1e1
+	#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
+field path                 ; # input filename to view in $commit
+
+field current_fd        {} ; # background process running
+field highlight_line    -1 ; # current line selected
+field highlight_column  {} ; # current commit column selected
+field highlight_commit  {} ; # sha1 of commit selected
+
+field total_lines       0  ; # total length of file
+field blame_lines       0  ; # number of lines computed
+field amov_data            ; # list of {commit origfile origline}
+field asim_data            ; # list of {commit origfile origline}
+
+field r_commit             ; # commit currently being parsed
+field r_orig_line          ; # original line number
+field r_final_line         ; # final line number
+field r_line_count         ; # lines in this region
+
+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
+field tooltip_commit    {} ; # Commit(s) in tooltip
+
+constructor new {i_commit i_path} {
+	global cursor_ptr
+	variable active_color
+	variable group_colors
+
+	set commit $i_commit
+	set path   $i_path
+
+	make_toplevel top w
+	wm title $top "[appname] ([reponame]): File Viewer"
+
+	frame $w.header -background gold
+	label $w.header.commit_l \
+		-text {Commit:} \
+		-background gold \
+		-anchor w \
+		-justify left
+	set w_back $w.header.commit_b
+	label $w_back \
+		-image ::blame::img_back_arrow \
+		-borderwidth 0 \
+		-relief flat \
+		-state disabled \
+		-background gold \
+		-activebackground gold
+	bind $w_back <Button-1> "
+		if {\[$w_back cget -state\] eq {normal}} {
+			[cb _history_menu]
+		}
+		"
+	label $w.header.commit \
+		-textvariable @commit \
+		-background gold \
+		-anchor w \
+		-justify left
+	label $w.header.path_l \
+		-text {File:} \
+		-background gold \
+		-anchor w \
+		-justify left
+	set w_path $w.header.path
+	label $w_path \
+		-background gold \
+		-anchor w \
+		-justify left
+	pack $w.header.commit_l -side left
+	pack $w_back -side left
+	pack $w.header.commit -side left
+	pack $w_path -fill x -side right
+	pack $w.header.path_l -side right
+
+	panedwindow $w.file_pane -orient vertical
+	frame $w.file_pane.out
+	frame $w.file_pane.cm
+	$w.file_pane add $w.file_pane.out \
+		-sticky nsew \
+		-minsize 100 \
+		-height 100 \
+		-width 100
+	$w.file_pane add $w.file_pane.cm \
+		-sticky nsew \
+		-minsize 25 \
+		-height 25 \
+		-width 100
+
+	set w_line $w.file_pane.out.linenumber_t
+	text $w_line \
+		-takefocus 0 \
+		-highlightthickness 0 \
+		-padx 0 -pady 0 \
+		-background white -borderwidth 0 \
+		-state disabled \
+		-wrap none \
+		-height 40 \
+		-width 6 \
+		-font font_diff
+	$w_line tag conf linenumber -justify right -rmargin 5
+
+	set w_amov $w.file_pane.out.amove_t
+	text $w_amov \
+		-takefocus 0 \
+		-highlightthickness 0 \
+		-padx 0 -pady 0 \
+		-background white -borderwidth 0 \
+		-state disabled \
+		-wrap none \
+		-height 40 \
+		-width 5 \
+		-font font_diff
+	$w_amov tag conf author_abbr -justify right -rmargin 5
+	$w_amov tag conf curr_commit
+	$w_amov tag conf prior_commit -foreground blue -underline 1
+	$w_amov tag bind prior_commit \
+		<Button-1> \
+		"[cb _load_commit $w_amov @amov_data @%x,%y];break"
+
+	set w_asim $w.file_pane.out.asimple_t
+	text $w_asim \
+		-takefocus 0 \
+		-highlightthickness 0 \
+		-padx 0 -pady 0 \
+		-background white -borderwidth 0 \
+		-state disabled \
+		-wrap none \
+		-height 40 \
+		-width 4 \
+		-font font_diff
+	$w_asim tag conf author_abbr -justify right
+	$w_asim tag conf curr_commit
+	$w_asim tag conf prior_commit -foreground blue -underline 1
+	$w_asim tag bind prior_commit \
+		<Button-1> \
+		"[cb _load_commit $w_asim @asim_data @%x,%y];break"
+
+	set w_file $w.file_pane.out.file_t
+	text $w_file \
+		-takefocus 0 \
+		-highlightthickness 0 \
+		-padx 0 -pady 0 \
+		-background white -borderwidth 0 \
+		-state disabled \
+		-wrap none \
+		-height 40 \
+		-width 80 \
+		-xscrollcommand [list $w.file_pane.out.sbx set] \
+		-font font_diff
+
+	set w_columns [list $w_amov $w_asim $w_line $w_file]
+
+	scrollbar $w.file_pane.out.sbx \
+		-orient h \
+		-command [list $w_file xview]
+	scrollbar $w.file_pane.out.sby \
+		-orient v \
+		-command [list scrollbar2many $w_columns yview]
+	eval grid $w_columns $w.file_pane.out.sby -sticky nsew
+	grid conf \
+		$w.file_pane.out.sbx \
+		-column [expr {[llength $w_columns] - 1}] \
+		-sticky we
+	grid columnconfigure \
+		$w.file_pane.out \
+		[expr {[llength $w_columns] - 1}] \
+		-weight 1
+	grid rowconfigure $w.file_pane.out 0 -weight 1
+
+	set w_cviewer $w.file_pane.cm.t
+	text $w_cviewer \
+		-background white -borderwidth 0 \
+		-state disabled \
+		-wrap none \
+		-height 10 \
+		-width 80 \
+		-xscrollcommand [list $w.file_pane.cm.sbx set] \
+		-yscrollcommand [list $w.file_pane.cm.sby set] \
+		-font font_diff
+	$w_cviewer tag conf still_loading \
+		-font font_uiitalic \
+		-justify center
+	$w_cviewer tag conf header_key \
+		-tabs {3c} \
+		-background $active_color \
+		-font font_uibold
+	$w_cviewer tag conf header_val \
+		-background $active_color \
+		-font font_ui
+	$w_cviewer tag raise sel
+	scrollbar $w.file_pane.cm.sbx \
+		-orient h \
+		-command [list $w_cviewer xview]
+	scrollbar $w.file_pane.cm.sby \
+		-orient v \
+		-command [list $w_cviewer yview]
+	pack $w.file_pane.cm.sby -side right -fill y
+	pack $w.file_pane.cm.sbx -side bottom -fill x
+	pack $w_cviewer -expand 1 -fill both
+
+	set status [::status_bar::new $w.status]
+
+	menu $w.ctxm -tearoff 0
+	$w.ctxm add command \
+		-label "Copy Commit" \
+		-command [cb _copycommit]
+
+	foreach i $w_columns {
+		for {set g 0} {$g < [llength $group_colors]} {incr g} {
+			$i tag conf color$g -background [lindex $group_colors $g]
+		}
+
+		$i conf -cursor $cursor_ptr
+		$i conf -yscrollcommand [list many2scrollbar \
+			$w_columns yview $w.file_pane.out.sby]
+		bind $i <Button-1> "
+			[cb _hide_tooltip]
+			[cb _click $i @%x,%y]
+			focus $i
+		"
+		bind $i <Any-Motion>  [cb _show_tooltip $i @%x,%y]
+		bind $i <Any-Enter>   [cb _hide_tooltip]
+		bind $i <Any-Leave>   [cb _hide_tooltip]
+		bind_button3 $i "
+			[cb _hide_tooltip]
+			set cursorX %x
+			set cursorY %y
+			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] {
+		bind $i <Key-Up>        {catch {%W yview scroll -1 units};break}
+		bind $i <Key-Down>      {catch {%W yview scroll  1 units};break}
+		bind $i <Key-Left>      {catch {%W xview scroll -1 units};break}
+		bind $i <Key-Right>     {catch {%W xview scroll  1 units};break}
+		bind $i <Key-k>         {catch {%W yview scroll -1 units};break}
+		bind $i <Key-j>         {catch {%W yview scroll  1 units};break}
+		bind $i <Key-h>         {catch {%W xview scroll -1 units};break}
+		bind $i <Key-l>         {catch {%W xview scroll  1 units};break}
+		bind $i <Control-Key-b> {catch {%W yview scroll -1 pages};break}
+		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 $w_file    <Visibility> [list focus $w_file]
+
+	grid configure $w.header -sticky ew
+	grid configure $w.file_pane -sticky nsew
+	grid configure $w.status -sticky ew
+	grid columnconfigure $top 0 -weight 1
+	grid rowconfigure $top 0 -weight 0
+	grid rowconfigure $top 1 -weight 1
+	grid rowconfigure $top 2 -weight 0
+
+	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 < $scr_h} {set req_h $scr_h}
+	set g "${req_w}x${req_h}"
+	wm geometry $top $g
+	update
+
+	set old_height [winfo height $w.file_pane]
+	$w.file_pane sash place 0 \
+		[lindex [$w.file_pane sash coord 0] 0] \
+		[expr {int($old_height * 0.70)}]
+	bind $w.file_pane <Configure> \
+	"if {{$w.file_pane} eq {%W}} {[cb _resize %h]}"
+
+	_load $this {}
+}
+
+method _load {jump} {
+	variable group_colors
+
+	_hide_tooltip $this
+
+	if {$total_lines != 0 || $current_fd ne {}} {
+		if {$current_fd ne {}} {
+			catch {close $current_fd}
+			set current_fd {}
+		}
+
+		foreach i $w_columns {
+			$i conf -state normal
+			$i delete 0.0 end
+			foreach g [$i tag names] {
+				if {[regexp {^g[0-9a-f]{40}$} $g]} {
+					$i tag delete $g
+				}
+			}
+			$i conf -state disabled
+		}
+
+		$w_cviewer conf -state normal
+		$w_cviewer delete 0.0 end
+		$w_cviewer conf -state disabled
+
+		set highlight_line -1
+		set highlight_column {}
+		set highlight_commit {}
+		set total_lines 0
+	}
+
+	if {$history eq {}} {
+		$w_back conf -state disabled
+	} else {
+		$w_back conf -state normal
+	}
+
+	# Index 0 is always empty.  There is never line 0 as
+	# we use only 1 based lines, as that matches both with
+	# git-blame output and with Tk's text widget.
+	#
+	set amov_data [list [list]]
+	set asim_data [list [list]]
+
+	$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 fd [git_read cat-file blob "$commit:$path"]
+	}
+	fconfigure $fd -blocking 0 -translation lf -encoding binary
+	fileevent $fd readable [cb _read_file $fd $jump]
+	set current_fd $fd
+}
+
+method _history_menu {} {
+	set m $w.backmenu
+	if {[winfo exists $m]} {
+		$m delete 0 end
+	} else {
+		menu $m -tearoff 0
+	}
+
+	for {set i [expr {[llength $history] - 1}]
+		} {$i >= 0} {incr i -1} {
+		set e [lindex $history $i]
+		set c [lindex $e 0]
+		set f [lindex $e 1]
+
+		if {[regexp {^[0-9a-f]{40}$} $c]} {
+			set t [string range $c 0 8]...
+		} elseif {$c eq {}} {
+			set t {Working Directory}
+		} else {
+			set t $c
+		}
+		if {![catch {set summary $header($c,summary)}]} {
+			append t " $summary"
+			if {[string length $t] > 70} {
+				set t [string range $t 0 66]...
+			}
+		}
+
+		$m add command -label $t -command [cb _goback $i]
+	}
+	set X [winfo rootx $w_back]
+	set Y [expr {[winfo rooty $w_back] + [winfo height $w_back]}]
+	tk_popup $m $X $Y
+}
+
+method _goback {i} {
+	set dat [lindex $history $i]
+	set history [lrange $history 0 [expr {$i - 1}]]
+	set commit [lindex $dat 0]
+	set path [lindex $dat 1]
+	_load $this [lrange $dat 2 5]
+}
+
+method _read_file {fd jump} {
+	if {$fd ne $current_fd} {
+		catch {close $fd}
+		return
+	}
+
+	foreach i $w_columns {$i conf -state normal}
+	while {[gets $fd line] >= 0} {
+		regsub "\r\$" $line {} line
+		incr total_lines
+		lappend amov_data {}
+		lappend asim_data {}
+
+		if {$total_lines > 1} {
+			foreach i $w_columns {$i insert end "\n"}
+		}
+
+		$w_line insert end "$total_lines" linenumber
+		$w_file insert end "$line"
+	}
+
+	set ln_wc [expr {[string length $total_lines] + 2}]
+	if {[$w_line cget -width] < $ln_wc} {
+		$w_line conf -width $ln_wc
+	}
+
+	foreach i $w_columns {$i conf -state disabled}
+
+	if {[eof $fd]} {
+		close $fd
+
+		# If we don't force Tk to update the widgets *right now*
+		# none of our jump commands will cause a change in the UI.
+		#
+		update
+
+		if {[llength $jump] == 1} {
+			set highlight_line [lindex $jump 0]
+			$w_file see "$highlight_line.0"
+		} elseif {[llength $jump] == 4} {
+			set highlight_column [lindex $jump 0]
+			set highlight_line [lindex $jump 1]
+			$w_file xview moveto [lindex $jump 2]
+			$w_file yview moveto [lindex $jump 3]
+		}
+
+		_exec_blame $this $w_asim @asim_data \
+			[list] \
+			{ copy/move tracking}
+	}
+} ifdeleted { catch {close $fd} }
+
+method _exec_blame {cur_w cur_d options cur_s} {
+	lappend options --incremental
+	if {$commit eq {}} {
+		lappend options --contents $path
+	} else {
+		lappend options $commit
+	}
+	lappend options -- $path
+	set fd [eval git_read --nice blame $options]
+	fconfigure $fd -blocking 0 -translation lf -encoding binary
+	fileevent $fd readable [cb _read_blame $fd $cur_w $cur_d]
+	set current_fd $fd
+	set blame_lines 0
+
+	$status start \
+		"Loading$cur_s annotations..." \
+		{lines annotated}
+}
+
+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}
+		return
+	}
+
+	$cur_w conf -state normal
+	while {[gets $fd line] >= 0} {
+		if {[regexp {^([a-z0-9]{40}) (\d+) (\d+) (\d+)$} $line line \
+			cmit original_line final_line line_count]} {
+			set r_commit     $cmit
+			set r_orig_line  $original_line
+			set r_final_line $final_line
+			set r_line_count $line_count
+		} elseif {[string match {filename *} $line]} {
+			set file [string range $line 9 end]
+			set n    $r_line_count
+			set lno  $r_final_line
+			set oln  $r_orig_line
+			set cmit $r_commit
+
+			if {[regexp {^0{40}$} $cmit]} {
+				set commit_abbr work
+				set commit_type curr_commit
+			} elseif {$cmit eq $commit} {
+				set commit_abbr this
+				set commit_type curr_commit
+			} else {
+				set commit_type prior_commit
+				set commit_abbr [string range $cmit 0 3]
+			}
+
+			set author_abbr {}
+			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
+				if {![regsub \
+					{^[[:upper:]][^\s]*\s+} \
+					$a_name {} a_name ]} break
+			}
+			if {$author_abbr eq {}} {
+				set author_abbr { |}
+			} else {
+				set author_abbr [string range $author_abbr 0 3]
+			}
+			unset a_name
+
+			set first_lno $lno
+			while {
+			   $first_lno > 1
+			&& $cmit eq [lindex $line_data [expr {$first_lno - 1}] 0]
+			&& $file eq [lindex $line_data [expr {$first_lno - 1}] 1]
+			} {
+				incr first_lno -1
+			}
+
+			set color {}
+			if {$first_lno < $lno} {
+				foreach g [$w_file tag names $first_lno.0] {
+					if {[regexp {^color[0-9]+$} $g]} {
+						set color $g
+						break
+					}
+				}
+			} else {
+				set i [lsort [concat \
+					[$w_file tag names "[expr {$first_lno - 1}].0"] \
+					[$w_file tag names "[expr {$lno + $n}].0"] \
+					]]
+				for {set g 0} {$g < [llength $group_colors]} {incr g} {
+					if {[lsearch -sorted -exact $i color$g] == -1} {
+						set color color$g
+						break
+					}
+				}
+			}
+			if {$color eq {}} {
+				set color color0
+			}
+
+			while {$n > 0} {
+				set lno_e "$lno.0 lineend + 1c"
+				if {[lindex $line_data $lno] ne {}} {
+					set g [lindex $line_data $lno 0]
+					foreach i $w_columns {
+						$i tag remove g$g $lno.0 $lno_e
+					}
+				}
+				lset line_data $lno [list $cmit $file $oln]
+
+				$cur_w delete $lno.0 "$lno.0 lineend"
+				if {$lno == $first_lno} {
+					$cur_w insert $lno.0 $commit_abbr $commit_type
+				} elseif {$lno == [expr {$first_lno + 1}]} {
+					$cur_w insert $lno.0 $author_abbr author_abbr
+				} else {
+					$cur_w insert $lno.0 { |}
+				}
+
+				foreach i $w_columns {
+					if {$cur_w eq $w_amov} {
+						for {set g 0} \
+							{$g < [llength $group_colors]} \
+							{incr g} {
+							$i tag remove color$g $lno.0 $lno_e
+						}
+						$i tag add $color $lno.0 $lno_e
+					}
+					$i tag add g$cmit $lno.0 $lno_e
+				}
+
+				if {$highlight_column eq $cur_w} {
+					if {$highlight_line == -1
+					 && [lindex [$w_file yview] 0] == 0} {
+						$w_file see $lno.0
+						set highlight_line $lno
+					}
+					if {$highlight_line == $lno} {
+						_showcommit $this $cur_w $lno
+					}
+				}
+
+				incr n -1
+				incr lno
+				incr oln
+				incr blame_lines
+			}
+
+			while {
+			   $cmit eq [lindex $line_data $lno 0]
+			&& $file eq [lindex $line_data $lno 1]
+			} {
+				$cur_w delete $lno.0 "$lno.0 lineend"
+
+				if {$lno == $first_lno} {
+					$cur_w insert $lno.0 $commit_abbr $commit_type
+				} elseif {$lno == [expr {$first_lno + 1}]} {
+					$cur_w insert $lno.0 $author_abbr author_abbr
+				} else {
+					$cur_w insert $lno.0 { |}
+				}
+
+				if {$cur_w eq $w_amov} {
+					foreach i $w_columns {
+						for {set g 0} \
+							{$g < [llength $group_colors]} \
+							{incr g} {
+							$i tag remove color$g $lno.0 $lno_e
+						}
+						$i tag add $color $lno.0 $lno_e
+					}
+				}
+
+				incr lno
+			}
+
+		} elseif {[regexp {^([a-z-]+) (.*)$} $line line key data]} {
+			set header($r_commit,$key) $data
+		}
+	}
+	$cur_w conf -state disabled
+
+	if {[eof $fd]} {
+		close $fd
+		if {$cur_w eq $w_asim} {
+			_exec_blame $this $w_amov @amov_data \
+				$original_options \
+				{ original location}
+		} else {
+			set current_fd {}
+			$status stop {Annotation complete.}
+		}
+	} else {
+		$status update $blame_lines $total_lines
+	}
+} ifdeleted { catch {close $fd} }
+
+method _click {cur_w pos} {
+	set lno [lindex [split [$cur_w index $pos] .] 0]
+	_showcommit $this $cur_w $lno
+}
+
+method _load_commit {cur_w cur_d pos} {
+	upvar #0 $cur_d line_data
+	set lno [lindex [split [$cur_w index $pos] .] 0]
+	set dat [lindex $line_data $lno]
+	if {$dat ne {}} {
+		lappend history [list \
+			$commit $path \
+			$highlight_column \
+			$highlight_line \
+			[lindex [$w_file xview] 0] \
+			[lindex [$w_file yview] 0] \
+			]
+		set commit [lindex $dat 0]
+		set path   [lindex $dat 1]
+		_load $this [list [lindex $dat 2]]
+	}
+}
+
+method _showcommit {cur_w lno} {
+	global repo_config
+	variable active_color
+
+	if {$highlight_commit ne {}} {
+		foreach i $w_columns {
+			$i tag conf g$highlight_commit -background {}
+			$i tag lower g$highlight_commit
+		}
+	}
+
+	if {$cur_w eq $w_asim} {
+		set dat [lindex $asim_data $lno]
+		set highlight_column $w_asim
+	} else {
+		set dat [lindex $amov_data $lno]
+		set highlight_column $w_amov
+	}
+
+	$w_cviewer conf -state normal
+	$w_cviewer delete 0.0 end
+
+	if {$dat eq {}} {
+		set cmit {}
+		$w_cviewer insert end "Loading annotation..." still_loading
+	} else {
+		set cmit [lindex $dat 0]
+		set file [lindex $dat 1]
+
+		foreach i $w_columns {
+			$i tag conf g$cmit -background $active_color
+			$i tag raise g$cmit
+		}
+
+		set author_name {}
+		set author_email {}
+		set author_time {}
+		catch {set author_name $header($cmit,author)}
+		catch {set author_email $header($cmit,author-mail)}
+		catch {set author_time [clock format \
+			$header($cmit,author-time) \
+			-format {%Y-%m-%d %H:%M:%S}
+		]}
+
+		set committer_name {}
+		set committer_email {}
+		set committer_time {}
+		catch {set committer_name $header($cmit,committer)}
+		catch {set committer_email $header($cmit,committer-mail)}
+		catch {set committer_time [clock format \
+			$header($cmit,committer-time) \
+			-format {%Y-%m-%d %H:%M:%S}
+		]}
+
+		if {[catch {set msg $header($cmit,message)}]} {
+			set msg {}
+			catch {
+				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
+				}
+				while {[gets $fd line] > 0} {
+					if {[string match {encoding *} $line]} {
+						set enc [string tolower [string range $line 9 end]]
+					}
+				}
+				set msg [read $fd]
+				close $fd
+
+				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
+		}
+
+		$w_cviewer insert end "commit $cmit\n" header_key
+		$w_cviewer insert end "Author:\t" header_key
+		$w_cviewer insert end "$author_name $author_email" header_val
+		$w_cviewer insert end "  $author_time\n" header_val
+
+		$w_cviewer insert end "Committer:\t" header_key
+		$w_cviewer insert end "$committer_name $committer_email" header_val
+		$w_cviewer insert end "  $committer_time\n" header_val
+
+		if {$file ne $path} {
+			$w_cviewer insert end "Original File:\t" header_key
+			$w_cviewer insert end "[escape_path $file]\n" header_val
+		}
+
+		$w_cviewer insert end "\n$msg"
+	}
+	$w_cviewer conf -state disabled
+
+	set highlight_line $lno
+	set highlight_commit $cmit
+
+	if {[lsearch -exact $tooltip_commit $highlight_commit] != -1} {
+		_hide_tooltip $this
+	}
+}
+
+method _copycommit {} {
+	set pos @$::cursorX,$::cursorY
+	set lno [lindex [split [$::cursorW index $pos] .] 0]
+	set dat [lindex $amov_data $lno]
+	if {$dat ne {}} {
+		clipboard clear
+		clipboard append \
+			-format STRING \
+			-type STRING \
+			-- [lindex $dat 0]
+	}
+}
+
+method _show_tooltip {cur_w pos} {
+	if {$tooltip_wm ne {}} {
+		_open_tooltip $this $cur_w
+	} elseif {$tooltip_timer eq {}} {
+		set tooltip_timer [after 1000 [cb _open_tooltip $cur_w]]
+	}
+}
+
+method _open_tooltip {cur_w} {
+	set tooltip_timer {}
+	set pos_x [winfo pointerx $cur_w]
+	set pos_y [winfo pointery $cur_w]
+	if {[winfo containing $pos_x $pos_y] ne $cur_w} {
+		_hide_tooltip $this
+		return
+	}
+
+	if {$tooltip_wm ne "$cur_w.tooltip"} {
+		_hide_tooltip $this
+
+		set tooltip_wm [toplevel $cur_w.tooltip -borderwidth 1]
+		wm overrideredirect $tooltip_wm 1
+		wm transient $tooltip_wm [winfo toplevel $cur_w]
+		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
+		pack $tooltip_t
+	} else {
+		$tooltip_t conf -state normal
+		$tooltip_t delete 0.0 end
+	}
+
+	set pos @[join [list \
+		[expr {$pos_x - [winfo rootx $cur_w]}] \
+		[expr {$pos_y - [winfo rooty $cur_w]}]] ,]
+	set lno [lindex [split [$cur_w index $pos] .] 0]
+	if {$cur_w eq $w_amov} {
+		set dat [lindex $amov_data $lno]
+		set org {}
+	} else {
+		set dat [lindex $asim_data $lno]
+		set org [lindex $amov_data $lno]
+	}
+
+	if {$dat eq {}} {
+		_hide_tooltip $this
+		return
+	}
+
+	set cmit [lindex $dat 0]
+	set tooltip_commit [list $cmit]
+
+	set author_name {}
+	set summary     {}
+	set author_time {}
+	catch {set author_name $header($cmit,author)}
+	catch {set summary     $header($cmit,summary)}
+	catch {set author_time [clock format \
+		$header($cmit,author-time) \
+		-format {%Y-%m-%d %H:%M:%S}
+	]}
+
+	$tooltip_t insert end "commit $cmit\n"
+	$tooltip_t insert end "$author_name  $author_time\n"
+	$tooltip_t insert end "$summary"
+
+	if {$org ne {} && [lindex $org 0] ne $cmit} {
+		set save [$tooltip_t get 0.0 end]
+		$tooltip_t delete 0.0 end
+
+		set cmit [lindex $org 0]
+		set file [lindex $org 1]
+		lappend tooltip_commit $cmit
+
+		set author_name {}
+		set summary     {}
+		set author_time {}
+		catch {set author_name $header($cmit,author)}
+		catch {set summary     $header($cmit,summary)}
+		catch {set author_time [clock format \
+			$header($cmit,author-time) \
+			-format {%Y-%m-%d %H:%M:%S}
+		]}
+
+		$tooltip_t insert end "Originally By:\n" section_header
+		$tooltip_t insert end "commit $cmit\n"
+		$tooltip_t insert end "$author_name  $author_time\n"
+		$tooltip_t insert end "$summary\n"
+
+		if {$file ne $path} {
+			$tooltip_t insert end "In File: " section_header
+			$tooltip_t insert end "$file\n"
+		}
+
+		$tooltip_t insert end "\n"
+		$tooltip_t insert end "Copied Or Moved Here By:\n" section_header
+		$tooltip_t insert end $save
+	}
+
+	$tooltip_t conf -state disabled
+	_position_tooltip $this
+}
+
+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 {}
+		set tooltip_commit {}
+	}
+	if {$tooltip_timer ne {}} {
+		after cancel $tooltip_timer
+		set tooltip_timer {}
+	}
+}
+
+method _resize {new_height} {
+	set diff [expr {$new_height - $old_height}]
+	if {$diff == 0} return
+
+	set my [expr {[winfo height $w.file_pane] - 25}]
+	set o [$w.file_pane sash coord 0]
+	set ox [lindex $o 0]
+	set oy [expr {[lindex $o 1] + $diff}]
+	if {$oy < 0}   {set oy 0}
+	if {$oy > $my} {set oy $my}
+	$w.file_pane sash place 0 $ox $oy
+
+	set old_height $new_height
+}
+
+}

lib/branch.tcl

@@ -0,0 +1,38 @@
+# git-gui branch (create/delete) support
+# Copyright (C) 2006, 2007 Shawn Pearce
+
+proc load_all_heads {} {
+	global some_heads_tracking
+
+	set rh refs/heads
+	set rh_len [expr {[string length $rh] + 1}]
+	set all_heads [list]
+	set fd [git_read for-each-ref --format=%(refname) $rh]
+	while {[gets $fd line] > 0} {
+		if {!$some_heads_tracking || ![is_tracking_branch $line]} {
+			lappend all_heads [string range $line $rh_len end]
+		}
+	}
+	close $fd
+
+	return [lsort $all_heads]
+}
+
+proc load_all_tags {} {
+	set all_tags [list]
+	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 $all_tags
+}
+
+proc radio_selector {varname value args} {
+	upvar #0 $varname var
+	set var $value
+}

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
+}
+
+}

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
+	}
+}
+
+}

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
+}
+
+}

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
+}
+
+}

lib/browser.tcl

@@ -0,0 +1,312 @@
+# git-gui tree browser
+# Copyright (C) 2006, 2007 Shawn Pearce
+
+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
+field browser_files  {}
+field browser_status {Starting...}
+field browser_stack  {}
+field browser_busy   1
+
+field ls_buf     {}; # Buffered record output from ls-tree
+
+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:$path
+
+	label $w.path \
+		-textvariable @browser_path \
+		-anchor w \
+		-justify left \
+		-borderwidth 1 \
+		-relief sunken \
+		-font font_uibold
+	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 \
+		-wrap none \
+		-height 20 \
+		-width 70 \
+		-xscrollcommand [list $w.list.sbx set] \
+		-yscrollcommand [list $w.list.sby set]
+	$w_list tag conf in_sel \
+		-background [$w_list cget -foreground] \
+		-foreground [$w_list cget -background]
+	scrollbar $w.list.sbx -orient h -command [list $w_list xview]
+	scrollbar $w.list.sby -orient v -command [list $w_list yview]
+	pack $w.list.sbx -side bottom -fill x
+	pack $w.list.sby -side right -fill y
+	pack $w_list -side left -fill both -expand 1
+	pack $w.list -side top -fill both -expand 1
+
+	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>        "[cb _click 0 @%x,%y];break"
+	bind $w_list <Double-Button-1> "[cb _click 1 @%x,%y];break"
+	bind $w_list <$M1B-Up>         "[cb _parent]        ;break"
+	bind $w_list <$M1B-Left>       "[cb _parent]        ;break"
+	bind $w_list <Up>              "[cb _move -1]       ;break"
+	bind $w_list <Down>            "[cb _move  1]       ;break"
+	bind $w_list <$M1B-Right>      "[cb _enter]         ;break"
+	bind $w_list <Return>          "[cb _enter]         ;break"
+	bind $w_list <Prior>           "[cb _page -1]       ;break"
+	bind $w_list <Next>            "[cb _page  1]       ;break"
+	bind $w_list <Left>            break
+	bind $w_list <Right>           break
+
+	bind $w_list <Visibility> [list focus $w_list]
+	set w $w_list
+	if {$path ne {}} {
+		_ls $this $browser_commit:$path $path
+	} else {
+		_ls $this $browser_commit $path
+	}
+	return $this
+}
+
+method _move {dir} {
+	if {$browser_busy} return
+	set lno [lindex [split [$w index in_sel.first] .] 0]
+	incr lno $dir
+	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
+	}
+}
+
+method _page {dir} {
+	if {$browser_busy} return
+	$w yview scroll $dir pages
+	set lno [expr {int(
+		  [lindex [$w yview] 0]
+		* [llength $browser_files]
+		+ 1)}]
+	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
+	}
+}
+
+method _parent {} {
+	if {$browser_busy} return
+	set info [lindex $browser_files 0]
+	if {[lindex $info 0] eq {parent}} {
+		set parent [lindex $browser_stack end-1]
+		set browser_stack [lrange $browser_stack 0 end-2]
+		if {$browser_stack eq {}} {
+			regsub {:.*$} $browser_path {:} browser_path
+		} else {
+			regsub {/[^/]+$} $browser_path {} browser_path
+		}
+		set browser_status "Loading $browser_path..."
+		_ls $this [lindex $parent 0] [lindex $parent 1]
+	}
+}
+
+method _enter {} {
+	if {$browser_busy} return
+	set lno [lindex [split [$w index in_sel.first] .] 0]
+	set info [lindex $browser_files [expr {$lno - 1}]]
+	if {$info ne {}} {
+		switch -- [lindex $info 0] {
+		parent {
+			_parent $this
+		}
+		tree {
+			set name [lindex $info 2]
+			set escn [escape_path $name]
+			set browser_status "Loading $escn..."
+			append browser_path $escn
+			_ls $this [lindex $info 1] $name
+		}
+		blob {
+			set name [lindex $info 2]
+			set p {}
+			foreach n $browser_stack {
+				append p [lindex $n 1]
+			}
+			append p $name
+			blame::new $browser_commit $p
+		}
+		}
+	}
+}
+
+method _click {was_double_click pos} {
+	if {$browser_busy} return
+	set lno [lindex [split [$w index $pos] .] 0]
+	focus $w
+
+	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} {
+			_enter $this
+		}
+	}
+}
+
+method _ls {tree_id {name {}}} {
+	set ls_buf {}
+	set browser_files {}
+	set browser_busy 1
+
+	$w conf -state normal
+	$w tag remove in_sel 0.0 end
+	$w delete 0.0 end
+	if {$browser_stack ne {}} {
+		$w image create end \
+			-align center -padx 5 -pady 1 \
+			-name icon0 \
+			-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 fd [git_read ls-tree -z $tree_id]
+	fconfigure $fd -blocking 0 -translation binary -encoding binary
+	fileevent $fd readable [cb _read $fd]
+}
+
+method _read {fd} {
+	append ls_buf [read $fd]
+	set pck [split $ls_buf "\0"]
+	set ls_buf [lindex $pck end]
+
+	set n [llength $browser_files]
+	$w conf -state normal
+	foreach p [lrange $pck 0 end-1] {
+		set tab [string first "\t" $p]
+		if {$tab == -1} continue
+
+		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 {
+		blob {
+			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 ::browser::img_tree
+			append path /
+		}
+		default {
+			set image ::browser::img_unknown
+		}
+		}
+
+		if {$n > 0} {$w insert end "\n"}
+		$w image create end \
+			-align center -padx 5 -pady 1 \
+			-name icon[incr n] \
+			-image $image
+		$w insert end [escape_path $path]
+		lappend browser_files [list $type $object $path]
+	}
+	$w conf -state disabled
+
+	if {[eof $fd]} {
+		close $fd
+		set browser_status Ready.
+		set browser_busy 0
+		set ls_buf {}
+		if {$n > 0} {
+			$w tag add in_sel 1.0 2.0
+			focus -force $w
+		}
+	}
+} ifdeleted {
+	catch {close $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
+}
+
+}

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
+}
+
+}

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 {}
+	}
+}
+
+}

lib/class.tcl

@@ -0,0 +1,185 @@
+# 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
+			concat \[list ${class}::\$name \$this\] \$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]::__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 \;
+		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 {}
+
+	append mbodyc {set __this [namespace qualifiers $this]} \;
+
+	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 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}
+}
+
+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

@@ -0,0 +1,431 @@
+# git-gui misc. commit reading/writing support
+# Copyright (C) 2006, 2007 Shawn Pearce
+
+proc load_last_commit {} {
+	global HEAD PARENT MERGE_HEAD commit_type ui_comm
+	global repo_config
+
+	if {[llength $PARENT] == 0} {
+		error_popup {There is nothing to amend.
+
+You are about to create the initial commit.  There is no commit before this to amend.
+}
+		return
+	}
+
+	repository_state curType curHEAD curMERGE_HEAD
+	if {$curType eq {merge}} {
+		error_popup {Cannot amend while merging.
+
+You are currently in the middle of a merge that has not been fully completed.  You cannot amend the prior commit unless you first abort the current merge activity.
+}
+		return
+	}
+
+	set msg {}
+	set parents [list]
+	if {[catch {
+			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
+			}
+			while {[gets $fd line] > 0} {
+				if {[string match {parent *} $line]} {
+					lappend parents [string range $line 7 end]
+				} elseif {[string match {encoding *} $line]} {
+					set enc [string tolower [string range $line 9 end]]
+				}
+			}
+			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
+	}
+
+	set HEAD $curHEAD
+	set PARENT $parents
+	set MERGE_HEAD [list]
+	switch -- [llength $parents] {
+	0       {set commit_type amend-initial}
+	1       {set commit_type amend}
+	default {set commit_type amend-merge}
+	}
+
+	$ui_comm delete 0.0 end
+	$ui_comm insert end $msg
+	$ui_comm edit reset
+	$ui_comm edit modified false
+	rescan ui_ready
+}
+
+set GIT_COMMITTER_IDENT {}
+
+proc committer_ident {} {
+	global GIT_COMMITTER_IDENT
+
+	if {$GIT_COMMITTER_IDENT eq {}} {
+		if {[catch {set me [git var GIT_COMMITTER_IDENT]} err]} {
+			error_popup "Unable to obtain your identity:\n\n$err"
+			return {}
+		}
+		if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
+			$me me GIT_COMMITTER_IDENT]} {
+			error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
+			return {}
+		}
+	}
+
+	return $GIT_COMMITTER_IDENT
+}
+
+proc do_signoff {} {
+	global ui_comm
+
+	set me [committer_ident]
+	if {$me eq {}} return
+
+	set sob "Signed-off-by: $me"
+	set last [$ui_comm get {end -1c linestart} {end -1c}]
+	if {$last ne $sob} {
+		$ui_comm edit separator
+		if {$last ne {}
+			&& ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
+			$ui_comm insert end "\n"
+		}
+		$ui_comm insert end "\n$sob"
+		$ui_comm edit separator
+		$ui_comm see end
+	}
+}
+
+proc create_new_commit {} {
+	global commit_type ui_comm
+
+	set commit_type normal
+	$ui_comm delete 0.0 end
+	$ui_comm edit reset
+	$ui_comm edit modified false
+	rescan ui_ready
+}
+
+proc commit_tree {} {
+	global HEAD commit_type file_states ui_comm repo_config
+	global pch_error
+
+	if {[committer_ident] eq {}} return
+	if {![lock_index update]} 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 another commit can be created.
+
+The rescan will be automatically started now.
+}
+		unlock_index
+		rescan ui_ready
+		return
+	}
+
+	# -- At least one file should differ in the index.
+	#
+	set files_ready 0
+	foreach path [array names file_states] {
+		switch -glob -- [lindex $file_states($path) 0] {
+		_? {continue}
+		A? -
+		D? -
+		M? {set files_ready 1}
+		U? {
+			error_popup "Unmerged files cannot be committed.
+
+File [short_path $path] has merge conflicts.  You must resolve them and stage the file before committing.
+"
+			unlock_index
+			return
+		}
+		default {
+			error_popup "Unknown file state [lindex $s 0] detected.
+
+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 stage at least 1 file before you can commit.
+}
+		unlock_index
+		return
+	}
+
+	# -- A message is required.
+	#
+	set msg [string trim [$ui_comm get 1.0 end]]
+	regsub -all -line {[ \t\r]+$} $msg {} msg
+	if {$msg eq {}} {
+		error_popup {Please supply a commit message.
+
+A good commit message has the following format:
+
+- First line: Describe in one sentance what you did.
+- Second line: Blank
+- Remaining lines: Describe why this change is good.
+}
+		unlock_index
+		return
+	}
+
+	# -- Run the pre-commit hook.
+	#
+	set pchook [gitdir hooks pre-commit]
+
+	# On Cygwin [file executable] might lie so we need to ask
+	# the shell if the hook is executable.  Yes that's annoying.
+	#
+	if {[is_Cygwin] && [file isfile $pchook]} {
+		set pchook [list sh -c [concat \
+			"if test -x \"$pchook\";" \
+			"then exec \"$pchook\" 2>&1;" \
+			"fi"]]
+	} elseif {[file executable $pchook]} {
+		set pchook [list $pchook |& cat]
+	} else {
+		commit_writetree $curHEAD $msg
+		return
+	}
+
+	ui_status {Calling pre-commit hook...}
+	set pch_error {}
+	set fd_ph [open "| $pchook" r]
+	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
+
+	append pch_error [read $fd_ph]
+	fconfigure $fd_ph -blocking 1
+	if {[eof $fd_ph]} {
+		if {[catch {close $fd_ph}]} {
+			ui_status {Commit declined by pre-commit hook.}
+			hook_failed_popup pre-commit $pch_error
+			unlock_index
+		} else {
+			commit_writetree $curHEAD $msg
+		}
+		set pch_error {}
+		return
+	}
+	fconfigure $fd_ph -blocking 0
+}
+
+proc commit_writetree {curHEAD msg} {
+	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 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"
+		ui_status {Commit failed.}
+		unlock_index
+		return
+	}
+
+	# -- Verify this wasn't an empty change.
+	#
+	if {$commit_type eq {normal}} {
+		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
+
+		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.
+
+No files were modified by this commit and it was not a merge commit.
+
+A rescan will be automatically started now.
+}
+			unlock_index
+			rescan {ui_status {No changes to commit.}}
+			return
+		}
+	}
+
+	# -- Build the message.
+	#
+	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
+	}
+	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.
+	#
+	set cmd [list commit-tree $tree_id]
+	foreach p [concat $PARENT $MERGE_HEAD] {
+		lappend cmd -p $p
+	}
+	lappend cmd <$msg_p
+	if {[catch {set cmt_id [eval git $cmd]} err]} {
+		error_popup "commit-tree failed:\n\n$err"
+		ui_status {Commit failed.}
+		unlock_index
+		return
+	}
+
+	# -- Update the HEAD ref.
+	#
+	set reflogm commit
+	if {$commit_type ne {normal}} {
+		append reflogm " ($commit_type)"
+	}
+	set i [string first "\n" $msg]
+	if {$i >= 0} {
+		set subject [string range $msg 0 [expr {$i - 1}]]
+	} else {
+		set subject $msg
+	}
+	append reflogm {: } $subject
+	if {[catch {
+			git update-ref -m $reflogm HEAD $cmt_id $curHEAD
+		} err]} {
+		error_popup "update-ref failed:\n\n$err"
+		ui_status {Commit failed.}
+		unlock_index
+		return
+	}
+
+	# -- Cleanup after ourselves.
+	#
+	catch {file delete $msg_p}
+	catch {file delete [gitdir MERGE_HEAD]}
+	catch {file delete [gitdir MERGE_MSG]}
+	catch {file delete [gitdir SQUASH_MSG]}
+	catch {file delete [gitdir GITGUI_MSG]}
+
+	# -- Let rerere do its thing.
+	#
+	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}
+	}
+
+	# -- Run the post-commit hook.
+	#
+	set pchook [gitdir hooks post-commit]
+	if {[is_Cygwin] && [file isfile $pchook]} {
+		set pchook [list sh -c [concat \
+			"if test -x \"$pchook\";" \
+			"then exec \"$pchook\";" \
+			"fi"]]
+	} elseif {![file executable $pchook]} {
+		set pchook {}
+	}
+	if {$pchook ne {}} {
+		catch {exec $pchook &}
+	}
+
+	$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
+
+	# -- Update in memory status
+	#
+	set selected_commit_type new
+	set commit_type normal
+	set HEAD $cmt_id
+	set PARENT $cmt_id
+	set MERGE_HEAD [list]
+
+	foreach path [array names file_states] {
+		set s $file_states($path)
+		set m [lindex $s 0]
+		switch -glob -- $m {
+		_O -
+		_M -
+		_D {continue}
+		__ -
+		A_ -
+		M_ -
+		D_ {
+			unset file_states($path)
+			catch {unset selected_paths($path)}
+		}
+		DO {
+			set file_states($path) [list _O [lindex $s 1] {} {}]
+		}
+		AM -
+		AD -
+		MM -
+		MD {
+			set file_states($path) [list \
+				_[string index $m 1] \
+				[lindex $s 1] \
+				[lindex $s 3] \
+				{}]
+		}
+		}
+	}
+
+	display_all_files
+	unlock_index
+	reshow_diff
+	ui_status "Created commit [string range $cmt_id 0 7]: $subject"
+}

lib/console.tcl

@@ -0,0 +1,203 @@
+# git-gui console support
+# Copyright (C) 2006, 2007 Shawn Pearce
+
+class console {
+
+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
+	set t_long $long_title
+	_init $this
+	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
+
+	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
+	label $w.m.l1 \
+		-textvariable @t_long  \
+		-anchor w \
+		-justify left \
+		-font font_uibold
+	text $w.m.t \
+		-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
+
+	menu $w.ctxm -tearoff 0
+	$w.ctxm add command -label "Copy" \
+		-command "tk_textCopy $w.m.t"
+	$w.ctxm add command -label "Select All" \
+		-command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
+	$w.ctxm add command -label "Copy All" \
+		-command "
+			$w.m.t tag add sel 0.0 end
+			tk_textCopy $w.m.t
+			$w.m.t tag remove sel 0.0 end
+		"
+
+	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"
+}
+
+method exec {cmd {after {}}} {
+	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]
+	}
+	fconfigure $fd_f -blocking 0 -translation binary
+	fileevent $fd_f readable [cb _read $fd_f $after]
+}
+
+method _read {fd after} {
+	set buf [read $fd]
+	if {$buf ne {}} {
+		if {![winfo exists $w.m.t]} {_init $this}
+		$w.m.t conf -state normal
+		set c 0
+		set n [string length $buf]
+		while {$c < $n} {
+			set cr [string first "\r" $buf $c]
+			set lf [string first "\n" $buf $c]
+			if {$cr < 0} {set cr [expr {$n + 1}]}
+			if {$lf < 0} {set lf [expr {$n + 1}]}
+
+			if {$lf < $cr} {
+				$w.m.t insert end [string range $buf $c $lf]
+				set console_cr [$w.m.t index {end -1c}]
+				set c $lf
+				incr c
+			} else {
+				$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
+				incr c
+			}
+		}
+		$w.m.t conf -state disabled
+		$w.m.t see end
+	}
+
+	fconfigure $fd -blocking 1
+	if {[eof $fd]} {
+		if {[catch {close $fd}]} {
+			set ok 0
+		} else {
+			set ok 1
+		}
+		if {$after ne {}} {
+			uplevel #0 $after $ok
+		} else {
+			done $this $ok
+		}
+		return
+	}
+	fconfigure $fd -blocking 0
+}
+
+method chain {cmdlist {ok 1}} {
+	if {$ok} {
+		if {[llength $cmdlist] == 0} {
+			done $this $ok
+			return
+		}
+
+		set cmd [lindex $cmdlist 0]
+		set cmdlist [lrange $cmdlist 1 end]
+
+		if {[lindex $cmd 0] eq {exec}} {
+			exec $this \
+				[lrange $cmd 1 end] \
+				[cb chain $cmdlist]
+		} else {
+			uplevel #0 $cmd [cb chain $cmdlist]
+		}
+	} else {
+		done $this $ok
+	}
+}
+
+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}
+			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}
+		if {$is_toplevel} {
+			$w.ok conf -state normal
+			focus $w.ok
+		}
+	}
+	delete_this
+}
+
+}

lib/database.tcl

@@ -0,0 +1,116 @@
+# git-gui object database management support
+# Copyright (C) 2006, 2007 Shawn Pearce
+
+proc do_stats {} {
+	set fd [git_read count-objects -v]
+	while {[gets $fd line] > 0} {
+		if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
+			set stats($name) $value
+		}
+	}
+	close $fd
+
+	set packed_sz 0
+	foreach p [glob -directory [gitdir objects pack] \
+		-type f \
+		-nocomplain -- *] {
+		incr packed_sz [file size $p]
+	}
+	if {$packed_sz > 0} {
+		set stats(size-pack) [expr {$packed_sz / 1024}]
+	}
+
+	set w .stats_view
+	toplevel $w
+	wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
+
+	label $w.header -text {Database Statistics}
+	pack $w.header -side top -fill x
+
+	frame $w.buttons -border 1
+	button $w.buttons.close -text Close \
+		-default active \
+		-command [list destroy $w]
+	button $w.buttons.gc -text {Compress Database} \
+		-default normal \
+		-command "destroy $w;do_gc"
+	pack $w.buttons.close -side right
+	pack $w.buttons.gc -side left
+	pack $w.buttons -side bottom -fill x -pady 10 -padx 10
+
+	frame $w.stat -borderwidth 1 -relief solid
+	foreach s {
+		{count           {Number of loose objects}}
+		{size            {Disk space used by loose objects} { KiB}}
+		{in-pack         {Number of packed objects}}
+		{packs           {Number of packs}}
+		{size-pack       {Disk space used by packed objects} { KiB}}
+		{prune-packable  {Packed objects waiting for pruning}}
+		{garbage         {Garbage files}}
+		} {
+		set name [lindex $s 0]
+		set label [lindex $s 1]
+		if {[catch {set value $stats($name)}]} continue
+		if {[llength $s] > 2} {
+			set value "$value[lindex $s 2]"
+		}
+
+		label $w.stat.l_$name -text "$label:" -anchor w
+		label $w.stat.v_$name -text $value -anchor w
+		grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
+	}
+	pack $w.stat -pady 10 -padx 10
+
+	bind $w <Visibility> "grab $w; focus $w.buttons.close"
+	bind $w <Key-Escape> [list destroy $w]
+	bind $w <Key-Return> [list destroy $w]
+	wm title $w "[appname] ([reponame]): Database Statistics"
+	tkwait window $w
+}
+
+proc do_gc {} {
+	set w [console::new {gc} {Compressing the object database}]
+	console::chain $w {
+		{exec git pack-refs --prune}
+		{exec git reflog expire --all}
+		{exec git repack -a -d -l}
+		{exec git rerere gc}
+	}
+}
+
+proc do_fsck_objects {} {
+	set w [console::new {fsck-objects} \
+		{Verifying the object database with fsck-objects}]
+	set cmd [list git fsck-objects]
+	lappend cmd --full
+	lappend cmd --cache
+	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
+		}
+	}
+}

lib/diff.tcl

@@ -0,0 +1,337 @@
+# git-gui diff viewer
+# Copyright (C) 2006, 2007 Shawn Pearce
+
+proc clear_diff {} {
+	global ui_diff current_diff_path current_diff_header
+	global ui_index ui_workdir
+
+	$ui_diff conf -state normal
+	$ui_diff delete 0.0 end
+	$ui_diff conf -state disabled
+
+	set current_diff_path {}
+	set current_diff_header {}
+
+	$ui_index tag remove in_diff 0.0 end
+	$ui_workdir tag remove in_diff 0.0 end
+}
+
+proc reshow_diff {} {
+	global file_states file_lists
+	global current_diff_path current_diff_side
+
+	set p $current_diff_path
+	if {$p eq {}} {
+		# No diff is being shown.
+	} elseif {$current_diff_side eq {}
+		|| [catch {set s $file_states($p)}]
+		|| [lsearch -sorted -exact $file_lists($current_diff_side) $p] == -1} {
+		clear_diff
+	} else {
+		show_diff $p $current_diff_side
+	}
+}
+
+proc handle_empty_diff {} {
+	global current_diff_path file_states file_lists
+
+	set path $current_diff_path
+	set s $file_states($path)
+	if {[lindex $s 0] ne {_M}} return
+
+	info_popup "No differences detected.
+
+[short_path $path] has no changes.
+
+The modification date of this file was updated by another application, but the content within the file was not changed.
+
+A rescan will be automatically started to find other files which may have the same state."
+
+	clear_diff
+	display_file $path __
+	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_index ui_workdir
+	global current_diff_path current_diff_side current_diff_header
+
+	if {$diff_active || ![lock_index read]} return
+
+	clear_diff
+	if {$lno == {}} {
+		set lno [lsearch -sorted -exact $file_lists($w) $path]
+		if {$lno >= 0} {
+			incr lno
+		}
+	}
+	if {$lno >= 1} {
+		$w tag add in_diff $lno.0 [expr {$lno + 1}].0
+	}
+
+	set s $file_states($path)
+	set m [lindex $s 0]
+	set is_3way_diff 0
+	set diff_active 1
+	set current_diff_path $path
+	set current_diff_side $w
+	set current_diff_header {}
+	ui_status "Loading diff of [escape_path $path]..."
+
+	# - Git won't give us the diff, there's nothing to compare to!
+	#
+	if {$m eq {_O}} {
+		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
+			ui_status "Unable to display [escape_path $path]"
+			error_popup "Error loading file:\n\n$err"
+			return
+		}
+		$ui_diff conf -state normal
+		if {![catch {set type [exec file $path]}]} {
+			set n [string length $path]
+			if {[string equal -length $n $path $type]} {
+				set type [string range $type $n end]
+				regsub {^:?\s*} $type {} type
+			}
+			$ui_diff insert end "* $type\n" d_@
+		}
+		if {[string first "\0" $content] != -1} {
+			$ui_diff insert end \
+				"* Binary file (not showing content)." \
+				d_@
+		} else {
+			if {$sz > $max_sz} {
+				$ui_diff insert end \
+"* Untracked file is $sz bytes.
+* Showing only first $max_sz bytes.
+" d_@
+			}
+			$ui_diff insert end $content
+			if {$sz > $max_sz} {
+				$ui_diff insert end "
+* Untracked file clipped here by [appname].
+* To see the entire file, use an external editor.
+" d_@
+			}
+		}
+		$ui_diff conf -state disabled
+		set diff_active 0
+		unlock_index
+		ui_ready
+		return
+	}
+
+	set cmd [list]
+	if {$w eq $ui_index} {
+		lappend cmd diff-index
+		lappend cmd --cached
+	} elseif {$w eq $ui_workdir} {
+		if {[string index $m 0] eq {U}} {
+			lappend cmd diff
+		} else {
+			lappend cmd diff-files
+		}
+	}
+
+	lappend cmd -p
+	lappend cmd --no-color
+	if {$repo_config(gui.diffcontext) >= 0} {
+		lappend cmd "-U$repo_config(gui.diffcontext)"
+	}
+	if {$w eq $ui_index} {
+		lappend cmd [PARENT]
+	}
+	lappend cmd --
+	lappend cmd $path
+
+	if {[catch {set fd [eval git_read --nice $cmd]} err]} {
+		set diff_active 0
+		unlock_index
+		ui_status "Unable to display [escape_path $path]"
+		error_popup "Error loading diff:\n\n$err"
+		return
+	}
+
+	fconfigure $fd \
+		-blocking 0 \
+		-encoding binary \
+		-translation binary
+	fileevent $fd readable [list read_diff $fd]
+}
+
+proc read_diff {fd} {
+	global ui_diff diff_active
+	global is_3way_diff current_diff_header
+
+	$ui_diff conf -state normal
+	while {[gets $fd line] >= 0} {
+		# -- Cleanup uninteresting diff header lines.
+		#
+		if {   [string match {diff --git *}      $line]
+			|| [string match {diff --cc *}       $line]
+			|| [string match {diff --combined *} $line]
+			|| [string match {--- *}             $line]
+			|| [string match {+++ *}             $line]} {
+			append current_diff_header $line "\n"
+			continue
+		}
+		if {[string match {index *} $line]} continue
+		if {$line eq {deleted file mode 120000}} {
+			set line "deleted symlink"
+		}
+
+		# -- Automatically detect if this is a 3 way diff.
+		#
+		if {[string match {@@@ *} $line]} {set is_3way_diff 1}
+
+		if {[string match {mode *} $line]
+			|| [string match {new file *} $line]
+			|| [string match {deleted file *} $line]
+			|| [string match {Binary files * and * differ} $line]
+			|| $line eq {\ No newline at end of file}
+			|| [regexp {^\* Unmerged path } $line]} {
+			set tags {}
+		} elseif {$is_3way_diff} {
+			set op [string range $line 0 1]
+			switch -- $op {
+			{  } {set tags {}}
+			{@@} {set tags d_@}
+			{ +} {set tags d_s+}
+			{ -} {set tags d_s-}
+			{+ } {set tags d_+s}
+			{- } {set tags d_-s}
+			{--} {set tags d_--}
+			{++} {
+				if {[regexp {^\+\+([<>]{7} |={7})} $line _g op]} {
+					set line [string replace $line 0 1 {  }]
+					set tags d$op
+				} else {
+					set tags d_++
+				}
+			}
+			default {
+				puts "error: Unhandled 3 way diff marker: {$op}"
+				set tags {}
+			}
+			}
+		} else {
+			set op [string index $line 0]
+			switch -- $op {
+			{ } {set tags {}}
+			{@} {set tags d_@}
+			{-} {set tags d_-}
+			{+} {
+				if {[regexp {^\+([<>]{7} |={7})} $line _g op]} {
+					set line [string replace $line 0 0 { }]
+					set tags d$op
+				} else {
+					set tags d_+
+				}
+			}
+			default {
+				puts "error: Unhandled 2 way diff marker: {$op}"
+				set tags {}
+			}
+			}
+		}
+		$ui_diff insert end $line $tags
+		if {[string index $line end] eq "\r"} {
+			$ui_diff tag add d_cr {end - 2c}
+		}
+		$ui_diff insert end "\n" $tags
+	}
+	$ui_diff conf -state disabled
+
+	if {[eof $fd]} {
+		close $fd
+		set diff_active 0
+		unlock_index
+		ui_ready
+
+		if {[$ui_diff index end] eq {2.0}} {
+			handle_empty_diff
+		}
+	}
+}
+
+proc apply_hunk {x y} {
+	global current_diff_path current_diff_header current_diff_side
+	global ui_diff ui_index file_states
+
+	if {$current_diff_path eq {} || $current_diff_header eq {}} return
+	if {![lock_index apply_hunk]} return
+
+	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
+		lappend apply_cmd --reverse
+		if {[string index $mi 0] ne {M}} {
+			unlock_index
+			return
+		}
+	} else {
+		set mode stage
+		if {[string index $mi 1] ne {M}} {
+			unlock_index
+			return
+		}
+	}
+
+	set s_lno [lindex [split [$ui_diff index @$x,$y] .] 0]
+	set s_lno [$ui_diff search -backwards -regexp ^@@ $s_lno.0 0.0]
+	if {$s_lno eq {}} {
+		unlock_index
+		return
+	}
+
+	set e_lno [$ui_diff search -forwards -regexp ^@@ "$s_lno + 1 lines" end]
+	if {$e_lno eq {}} {
+		set e_lno end
+	}
+
+	if {[catch {
+		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]
+		close $p} err]} {
+		error_popup "Failed to $mode selected hunk.\n\n$err"
+		unlock_index
+		return
+	}
+
+	$ui_diff conf -state normal
+	$ui_diff delete $s_lno $e_lno
+	$ui_diff conf -state disabled
+
+	if {[$ui_diff get 1.0 end] eq "\n"} {
+		set o _
+	} else {
+		set o ?
+	}
+
+	if {$current_diff_side eq $ui_index} {
+		set mi ${o}M
+	} elseif {[string index $mi 0] eq {_}} {
+		set mi M$o
+	} else {
+		set mi ?$o
+	}
+	unlock_index
+	display_file $current_diff_path $mi
+	if {$o eq {_}} {
+		clear_diff
+	}
+}

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 {}
+}

lib/error.tcl

@@ -0,0 +1,104 @@
+# git-gui branch (create/delete) support
+# Copyright (C) 2006, 2007 Shawn Pearce
+
+proc error_popup {msg} {
+	set title [appname]
+	if {[reponame] ne {}} {
+		append title " ([reponame])"
+	}
+	set cmd [list tk_messageBox \
+		-icon error \
+		-type ok \
+		-title "$title: error" \
+		-message $msg]
+	if {[winfo ismapped .]} {
+		lappend cmd -parent .
+	}
+	eval $cmd
+}
+
+proc warn_popup {msg} {
+	set title [appname]
+	if {[reponame] ne {}} {
+		append title " ([reponame])"
+	}
+	set cmd [list tk_messageBox \
+		-icon warning \
+		-type ok \
+		-title "$title: warning" \
+		-message $msg]
+	if {[winfo ismapped .]} {
+		lappend cmd -parent .
+	}
+	eval $cmd
+}
+
+proc info_popup {msg {parent .}} {
+	set title [appname]
+	if {[reponame] ne {}} {
+		append title " ([reponame])"
+	}
+	tk_messageBox \
+		-parent $parent \
+		-icon info \
+		-type ok \
+		-title $title \
+		-message $msg
+}
+
+proc ask_popup {msg} {
+	set title [appname]
+	if {[reponame] ne {}} {
+		append title " ([reponame])"
+	}
+	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} {
+	set w .hookfail
+	toplevel $w
+
+	frame $w.m
+	label $w.m.l1 -text "$hook hook failed:" \
+		-anchor w \
+		-justify left \
+		-font font_uibold
+	text $w.m.t \
+		-background white -borderwidth 1 \
+		-relief sunken \
+		-width 80 -height 10 \
+		-font font_diff \
+		-yscrollcommand [list $w.m.sby set]
+	label $w.m.l2 \
+		-text {You must correct the above errors before committing.} \
+		-anchor w \
+		-justify left \
+		-font font_uibold
+	scrollbar $w.m.sby -command [list $w.m.t yview]
+	pack $w.m.l1 -side top -fill x
+	pack $w.m.l2 -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
+
+	$w.m.t insert 1.0 $msg
+	$w.m.t conf -state disabled
+
+	button $w.ok -text OK \
+		-width 15 \
+		-command "destroy $w"
+	pack $w.ok -side bottom -anchor e -pady 10 -padx 10
+
+	bind $w <Visibility> "grab $w; focus $w"
+	bind $w <Key-Return> "destroy $w"
+	wm title $w "[appname] ([reponame]): error"
+	tkwait window $w
+}

lib/index.tcl

@@ -0,0 +1,409 @@
+# git-gui index (add/remove) support
+# Copyright (C) 2006, 2007 Shawn Pearce
+
+proc update_indexinfo {msg pathList after} {
+	global update_index_cp
+
+	if {![lock_index update]} return
+
+	set update_index_cp 0
+	set pathList [lsort $pathList]
+	set totalCnt [llength $pathList]
+	set batch [expr {int($totalCnt * .01) + 1}]
+	if {$batch > 25} {set batch 25}
+
+	ui_status [format \
+		"$msg... %i/%i files (%.2f%%)" \
+		$update_index_cp \
+		$totalCnt \
+		0.0]
+	set fd [git_write update-index -z --index-info]
+	fconfigure $fd \
+		-blocking 0 \
+		-buffering full \
+		-buffersize 512 \
+		-encoding binary \
+		-translation binary
+	fileevent $fd writable [list \
+		write_update_indexinfo \
+		$fd \
+		$pathList \
+		$totalCnt \
+		$batch \
+		$msg \
+		$after \
+		]
+}
+
+proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
+	global update_index_cp
+	global file_states current_diff_path
+
+	if {$update_index_cp >= $totalCnt} {
+		close $fd
+		unlock_index
+		uplevel #0 $after
+		return
+	}
+
+	for {set i $batch} \
+		{$update_index_cp < $totalCnt && $i > 0} \
+		{incr i -1} {
+		set path [lindex $pathList $update_index_cp]
+		incr update_index_cp
+
+		set s $file_states($path)
+		switch -glob -- [lindex $s 0] {
+		A? {set new _O}
+		M? {set new _M}
+		D_ {set new _D}
+		D? {set new _?}
+		?? {continue}
+		}
+		set info [lindex $s 2]
+		if {$info eq {}} continue
+
+		puts -nonewline $fd "$info\t[encoding convertto $path]\0"
+		display_file $path $new
+	}
+
+	ui_status [format \
+		"$msg... %i/%i files (%.2f%%)" \
+		$update_index_cp \
+		$totalCnt \
+		[expr {100.0 * $update_index_cp / $totalCnt}]]
+}
+
+proc update_index {msg pathList after} {
+	global update_index_cp
+
+	if {![lock_index update]} return
+
+	set update_index_cp 0
+	set pathList [lsort $pathList]
+	set totalCnt [llength $pathList]
+	set batch [expr {int($totalCnt * .01) + 1}]
+	if {$batch > 25} {set batch 25}
+
+	ui_status [format \
+		"$msg... %i/%i files (%.2f%%)" \
+		$update_index_cp \
+		$totalCnt \
+		0.0]
+	set fd [git_write update-index --add --remove -z --stdin]
+	fconfigure $fd \
+		-blocking 0 \
+		-buffering full \
+		-buffersize 512 \
+		-encoding binary \
+		-translation binary
+	fileevent $fd writable [list \
+		write_update_index \
+		$fd \
+		$pathList \
+		$totalCnt \
+		$batch \
+		$msg \
+		$after \
+		]
+}
+
+proc write_update_index {fd pathList totalCnt batch msg after} {
+	global update_index_cp
+	global file_states current_diff_path
+
+	if {$update_index_cp >= $totalCnt} {
+		close $fd
+		unlock_index
+		uplevel #0 $after
+		return
+	}
+
+	for {set i $batch} \
+		{$update_index_cp < $totalCnt && $i > 0} \
+		{incr i -1} {
+		set path [lindex $pathList $update_index_cp]
+		incr update_index_cp
+
+		switch -glob -- [lindex $file_states($path) 0] {
+		AD {set new __}
+		?D {set new D_}
+		_O -
+		AM {set new A_}
+		U? {
+			if {[file exists $path]} {
+				set new M_
+			} else {
+				set new D_
+			}
+		}
+		?M {set new M_}
+		?? {continue}
+		}
+		puts -nonewline $fd "[encoding convertto $path]\0"
+		display_file $path $new
+	}
+
+	ui_status [format \
+		"$msg... %i/%i files (%.2f%%)" \
+		$update_index_cp \
+		$totalCnt \
+		[expr {100.0 * $update_index_cp / $totalCnt}]]
+}
+
+proc checkout_index {msg pathList after} {
+	global update_index_cp
+
+	if {![lock_index update]} return
+
+	set update_index_cp 0
+	set pathList [lsort $pathList]
+	set totalCnt [llength $pathList]
+	set batch [expr {int($totalCnt * .01) + 1}]
+	if {$batch > 25} {set batch 25}
+
+	ui_status [format \
+		"$msg... %i/%i files (%.2f%%)" \
+		$update_index_cp \
+		$totalCnt \
+		0.0]
+	set fd [git_write checkout-index \
+		--index \
+		--quiet \
+		--force \
+		-z \
+		--stdin \
+		]
+	fconfigure $fd \
+		-blocking 0 \
+		-buffering full \
+		-buffersize 512 \
+		-encoding binary \
+		-translation binary
+	fileevent $fd writable [list \
+		write_checkout_index \
+		$fd \
+		$pathList \
+		$totalCnt \
+		$batch \
+		$msg \
+		$after \
+		]
+}
+
+proc write_checkout_index {fd pathList totalCnt batch msg after} {
+	global update_index_cp
+	global file_states current_diff_path
+
+	if {$update_index_cp >= $totalCnt} {
+		close $fd
+		unlock_index
+		uplevel #0 $after
+		return
+	}
+
+	for {set i $batch} \
+		{$update_index_cp < $totalCnt && $i > 0} \
+		{incr i -1} {
+		set path [lindex $pathList $update_index_cp]
+		incr update_index_cp
+		switch -glob -- [lindex $file_states($path) 0] {
+		U? {continue}
+		?M -
+		?D {
+			puts -nonewline $fd "[encoding convertto $path]\0"
+			display_file $path ?_
+		}
+		}
+	}
+
+	ui_status [format \
+		"$msg... %i/%i files (%.2f%%)" \
+		$update_index_cp \
+		$totalCnt \
+		[expr {100.0 * $update_index_cp / $totalCnt}]]
+}
+
+proc unstage_helper {txt paths} {
+	global file_states current_diff_path
+
+	if {![lock_index begin-update]} return
+
+	set pathList [list]
+	set after {}
+	foreach path $paths {
+		switch -glob -- [lindex $file_states($path) 0] {
+		A? -
+		M? -
+		D? {
+			lappend pathList $path
+			if {$path eq $current_diff_path} {
+				set after {reshow_diff;}
+			}
+		}
+		}
+	}
+	if {$pathList eq {}} {
+		unlock_index
+	} else {
+		update_indexinfo \
+			$txt \
+			$pathList \
+			[concat $after [list ui_ready]]
+	}
+}
+
+proc do_unstage_selection {} {
+	global current_diff_path selected_paths
+
+	if {[array size selected_paths] > 0} {
+		unstage_helper \
+			{Unstaging selected files from commit} \
+			[array names selected_paths]
+	} elseif {$current_diff_path ne {}} {
+		unstage_helper \
+			"Unstaging [short_path $current_diff_path] from commit" \
+			[list $current_diff_path]
+	}
+}
+
+proc add_helper {txt paths} {
+	global file_states current_diff_path
+
+	if {![lock_index begin-update]} return
+
+	set pathList [list]
+	set after {}
+	foreach path $paths {
+		switch -glob -- [lindex $file_states($path) 0] {
+		_O -
+		?M -
+		?D -
+		U? {
+			lappend pathList $path
+			if {$path eq $current_diff_path} {
+				set after {reshow_diff;}
+			}
+		}
+		}
+	}
+	if {$pathList eq {}} {
+		unlock_index
+	} else {
+		update_index \
+			$txt \
+			$pathList \
+			[concat $after {ui_status {Ready to commit.}}]
+	}
+}
+
+proc do_add_selection {} {
+	global current_diff_path selected_paths
+
+	if {[array size selected_paths] > 0} {
+		add_helper \
+			{Adding selected files} \
+			[array names selected_paths]
+	} elseif {$current_diff_path ne {}} {
+		add_helper \
+			"Adding [short_path $current_diff_path]" \
+			[list $current_diff_path]
+	}
+}
+
+proc do_add_all {} {
+	global file_states
+
+	set paths [list]
+	foreach path [array names file_states] {
+		switch -glob -- [lindex $file_states($path) 0] {
+		U? {continue}
+		?M -
+		?D {lappend paths $path}
+		}
+	}
+	add_helper {Adding all changed files} $paths
+}
+
+proc revert_helper {txt paths} {
+	global file_states current_diff_path
+
+	if {![lock_index begin-update]} return
+
+	set pathList [list]
+	set after {}
+	foreach path $paths {
+		switch -glob -- [lindex $file_states($path) 0] {
+		U? {continue}
+		?M -
+		?D {
+			lappend pathList $path
+			if {$path eq $current_diff_path} {
+				set after {reshow_diff;}
+			}
+		}
+		}
+	}
+
+	set n [llength $pathList]
+	if {$n == 0} {
+		unlock_index
+		return
+	} elseif {$n == 1} {
+		set s "[short_path [lindex $pathList]]"
+	} else {
+		set s "these $n files"
+	}
+
+	set reply [tk_dialog \
+		.confirm_revert \
+		"[appname] ([reponame])" \
+		"Revert changes in $s?
+
+Any unstaged changes will be permanently lost by the revert." \
+		question \
+		1 \
+		{Do Nothing} \
+		{Revert Changes} \
+		]
+	if {$reply == 1} {
+		checkout_index \
+			$txt \
+			$pathList \
+			[concat $after [list ui_ready]]
+	} else {
+		unlock_index
+	}
+}
+
+proc do_revert_selection {} {
+	global current_diff_path selected_paths
+
+	if {[array size selected_paths] > 0} {
+		revert_helper \
+			{Reverting selected files} \
+			[array names selected_paths]
+	} elseif {$current_diff_path ne {}} {
+		revert_helper \
+			"Reverting [short_path $current_diff_path]" \
+			[list $current_diff_path]
+	}
+}
+
+proc do_select_commit_type {} {
+	global commit_type selected_commit_type
+
+	if {$selected_commit_type eq {new}
+		&& [string match amend* $commit_type]} {
+		create_new_commit
+	} elseif {$selected_commit_type eq {amend}
+		&& ![string match amend* $commit_type]} {
+		load_last_commit
+
+		# The amend request was rejected...
+		#
+		if {![string match amend* $commit_type]} {
+			set selected_commit_type new
+		}
+	}
+}

lib/merge.tcl

@@ -0,0 +1,274 @@
+# git-gui branch merge support
+# Copyright (C) 2006, 2007 Shawn Pearce
+
+class merge {
+
+field w         ; # top level window
+field w_rev     ; # mega-widget to pick the revision to merge
+
+method _can_merge {} {
+	global HEAD commit_type file_states
+
+	if {[string match amend* $commit_type]} {
+		info_popup {Cannot merge while amending.
+
+You must finish amending this commit before starting any type of merge.
+}
+		return 0
+	}
+
+	if {[committer_ident] eq {}} {return 0}
+	if {![lock_index merge]} {return 0}
+
+	# -- Our in memory state should match the repository.
+	#
+	repository_state curType curHEAD curMERGE_HEAD
+	if {$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 a merge can be performed.
+
+The rescan will be automatically started now.
+}
+		unlock_index
+		rescan ui_ready
+		return 0
+	}
+
+	foreach path [array names file_states] {
+		switch -glob -- [lindex $file_states($path) 0] {
+		_O {
+			continue; # and pray it works!
+		}
+		U? {
+			error_popup "You are in the middle of a conflicted merge.
+
+File [short_path $path] has merge conflicts.
+
+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
+		}
+		?? {
+			error_popup "You are in the middle of a change.
+
+File [short_path $path] is modified.
+
+You should complete the current commit before starting a merge.  Doing so will help you abort a failed merge, should the need arise.
+"
+			unlock_index
+			return 0
+		}
+		}
+	}
+
+	return 1
+}
+
+method _rev {} {
+	if {[catch {$w_rev commit_or_die}]} {
+		return {}
+	}
+	return [$w_rev get]
+}
+
+method _visualize {} {
+	set rev [_rev $this]
+	if {$rev ne {}} {
+		do_gitk [list $rev --not HEAD]
+	}
+}
+
+method _start {} {
+	global HEAD current_branch remote_url
+
+	set name [_rev $this]
+	if {$name eq {}} {
+		return
+	}
+
+	set spec [$w_rev get_tracking_branch]
+	set cmit [$w_rev get_commit]
+
+	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"
+	}
+	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
+}
+
+method _finish {cons ok} {
+	console::done $cons $ok
+	if {$ok} {
+		set msg {Merge completed successfully.}
+	} else {
+		set msg {Merge failed.  Conflict resolution is required.}
+	}
+	unlock_index
+	rescan [list ui_status $msg]
+	delete_this
+}
+
+constructor dialog {} {
+	global current_branch
+	global M1B
+
+	if {![_can_merge $this]} {
+		delete_this
+		return
+	}
+
+	make_toplevel top w
+	wm title $top "[appname] ([reponame]): Merge"
+	if {$top ne {.}} {
+		wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
+	}
+
+	set _start [cb _start]
+
+	label $w.header \
+		-text "Merge Into $current_branch" \
+		-font font_uibold
+	pack $w.header -side top -fill x
+
+	frame $w.buttons
+	button $w.buttons.visualize \
+		-text Visualize \
+		-command [cb _visualize]
+	pack $w.buttons.visualize -side left
+	button $w.buttons.merge \
+		-text Merge \
+		-command $_start
+	pack $w.buttons.merge -side right
+	button $w.buttons.cancel \
+		-text {Cancel} \
+		-command [cb _cancel]
+	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_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 <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
+
+	if {[string match amend* $commit_type]} {
+		info_popup {Cannot abort while amending.
+
+You must finish amending this commit.
+}
+		return
+	}
+
+	if {![lock_index abort]} return
+
+	if {[string match *merge* $commit_type]} {
+		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_question "Reset changes?
+
+Resetting the changes will cause *ALL* uncommitted changes to be lost.
+
+Continue with resetting the current changes?"
+	}
+
+	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]]
+		$::main_status start {Aborting} {files reset}
+	} else {
+		unlock_index
+	}
+}
+
+proc _reset_wait {fd} {
+	global ui_comm
+
+	$::main_status update_meter [read $fd]
+
+	fconfigure $fd -blocking 1
+	if {[eof $fd]} {
+		set fail [catch {close $fd} err]
+		$::main_status stop
+		unlock_index
+
+		$ui_comm delete 0.0 end
+		$ui_comm edit modified false
+
+		catch {file delete [gitdir MERGE_HEAD]}
+		catch {file delete [gitdir rr-cache MERGE_RR]}
+		catch {file delete [gitdir SQUASH_MSG]}
+		catch {file delete [gitdir MERGE_MSG]}
+		catch {file delete [gitdir GITGUI_MSG]}
+
+		if {$fail} {
+			warn_popup "Abort failed.\n\n$err"
+		}
+		rescan {ui_status {Abort completed.  Ready.}}
+	} else {
+		fconfigure $fd -blocking 0
+	}
+}
+
+}

lib/option.tcl

@@ -0,0 +1,310 @@
+# git-gui options editor
+# Copyright (C) 2006, 2007 Shawn Pearce
+
+proc save_config {} {
+	global default_config font_descs
+	global repo_config global_config
+	global repo_config_new global_config_new
+
+	foreach option $font_descs {
+		set name [lindex $option 0]
+		set font [lindex $option 1]
+		font configure $font \
+			-family $global_config_new(gui.$font^^family) \
+			-size $global_config_new(gui.$font^^size)
+		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)
+	}
+
+	foreach name [array names default_config] {
+		set value $global_config_new($name)
+		if {$value ne $global_config($name)} {
+			if {$value eq $default_config($name)} {
+				catch {git config --global --unset $name}
+			} else {
+				regsub -all "\[{}\]" $value {"} value
+				git config --global $name $value
+			}
+			set global_config($name) $value
+			if {$value eq $repo_config($name)} {
+				catch {git config --unset $name}
+				set repo_config($name) $value
+			}
+		}
+	}
+
+	foreach name [array names default_config] {
+		set value $repo_config_new($name)
+		if {$value ne $repo_config($name)} {
+			if {$value eq $global_config($name)} {
+				catch {git config --unset $name}
+			} else {
+				regsub -all "\[{}\]" $value {"} value
+				git config $name $value
+			}
+			set repo_config($name) $value
+		}
+	}
+}
+
+proc do_about {} {
+	global appvers copyright oguilib
+	global tcl_patchLevel tk_patchLevel
+
+	set w .about_dialog
+	toplevel $w
+	wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
+
+	label $w.header -text "About [appname]" \
+		-font font_uibold
+	pack $w.header -side top -fill x
+
+	frame $w.buttons
+	button $w.buttons.close -text {Close} \
+		-default active \
+		-command [list destroy $w]
+	pack $w.buttons.close -side right
+	pack $w.buttons -side bottom -fill x -pady 10 -padx 10
+
+	label $w.desc \
+		-text "git-gui - a graphical user interface for Git.
+$copyright" \
+		-padx 5 -pady 5 \
+		-justify left \
+		-anchor w \
+		-borderwidth 1 \
+		-relief solid
+	pack $w.desc -side top -fill x -padx 5 -pady 5
+
+	set v {}
+	append v "git-gui version $appvers\n"
+	append v "[git version]\n"
+	append v "\n"
+	if {$tcl_patchLevel eq $tk_patchLevel} {
+		append v "Tcl/Tk version $tcl_patchLevel"
+	} else {
+		append v "Tcl version $tcl_patchLevel"
+		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 \
+		-justify left \
+		-anchor w \
+		-borderwidth 1 \
+		-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} \
+		-command "
+		clipboard clear
+		clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
+	"
+
+	bind $w <Visibility> "grab $w; focus $w.buttons.close"
+	bind $w <Key-Escape> "destroy $w"
+	bind $w <Key-Return> "destroy $w"
+	bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
+	wm title $w "About [appname]"
+	tkwait window $w
+}
+
+proc do_options {} {
+	global repo_config global_config font_descs
+	global repo_config_new global_config_new
+
+	array unset repo_config_new
+	array unset global_config_new
+	foreach name [array names repo_config] {
+		set repo_config_new($name) $repo_config($name)
+	}
+	load_config 1
+	foreach name [array names repo_config] {
+		switch -- $name {
+		gui.diffcontext {continue}
+		}
+		set repo_config_new($name) $repo_config($name)
+	}
+	foreach name [array names global_config] {
+		set global_config_new($name) $global_config($name)
+	}
+
+	set w .options_editor
+	toplevel $w
+	wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
+
+	label $w.header -text "Options" \
+		-font font_uibold
+	pack $w.header -side top -fill x
+
+	frame $w.buttons
+	button $w.buttons.restore -text {Restore Defaults} \
+		-default normal \
+		-command do_restore_defaults
+	pack $w.buttons.restore -side left
+	button $w.buttons.save -text Save \
+		-default active \
+		-command [list do_save_config $w]
+	pack $w.buttons.save -side right
+	button $w.buttons.cancel -text {Cancel} \
+		-default normal \
+		-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.repo -text "[reponame] Repository"
+	labelframe $w.global -text {Global (All Repositories)}
+	pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
+	pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
+
+	set optid 0
+	foreach option {
+		{t user.name {User Name}}
+		{t user.email {Email Address}}
+
+		{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}}
+		} {
+		set type [lindex $option 0]
+		set name [lindex $option 1]
+		set text [lindex $option 2]
+		incr optid
+		foreach f {repo global} {
+			switch -glob -- $type {
+			b {
+				checkbutton $w.$f.$optid -text $text \
+					-variable ${f}_config_new($name) \
+					-onvalue true \
+					-offvalue false
+				pack $w.$f.$optid -side top -anchor w
+			}
+			i-* {
+				regexp -- {-(\d+)\.\.(\d+)$} $type _junk min max
+				frame $w.$f.$optid
+				label $w.$f.$optid.l -text "$text:"
+				pack $w.$f.$optid.l -side left -anchor w -fill x
+				spinbox $w.$f.$optid.v \
+					-textvariable ${f}_config_new($name) \
+					-from $min \
+					-to $max \
+					-increment 1 \
+					-width [expr {1 + [string length $max]}]
+				bind $w.$f.$optid.v <FocusIn> {%W selection range 0 end}
+				pack $w.$f.$optid.v -side right -anchor e -padx 5
+				pack $w.$f.$optid -side top -anchor w -fill x
+			}
+			t {
+				frame $w.$f.$optid
+				label $w.$f.$optid.l -text "$text:"
+				entry $w.$f.$optid.v \
+					-borderwidth 1 \
+					-relief sunken \
+					-width 20 \
+					-textvariable ${f}_config_new($name)
+				pack $w.$f.$optid.l -side left -anchor w
+				pack $w.$f.$optid.v -side left -anchor w \
+					-fill x -expand 1 \
+					-padx 5
+				pack $w.$f.$optid -side top -anchor w -fill x
+			}
+			}
+		}
+	}
+
+	set all_fonts [lsort [font families]]
+	foreach option $font_descs {
+		set name [lindex $option 0]
+		set font [lindex $option 1]
+		set text [lindex $option 2]
+
+		set global_config_new(gui.$font^^family) \
+			[font configure $font -family]
+		set global_config_new(gui.$font^^size) \
+			[font configure $font -size]
+
+		frame $w.global.$name
+		label $w.global.$name.l -text "$text:"
+		pack $w.global.$name.l -side left -anchor w -fill x
+		eval tk_optionMenu $w.global.$name.family \
+			global_config_new(gui.$font^^family) \
+			$all_fonts
+		spinbox $w.global.$name.size \
+			-textvariable global_config_new(gui.$font^^size) \
+			-from 2 -to 80 -increment 1 \
+			-width 3
+		bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
+		pack $w.global.$name.size -side right -anchor e
+		pack $w.global.$name.family -side right -anchor e
+		pack $w.global.$name -side top -anchor w -fill x
+	}
+
+	bind $w <Visibility> "grab $w; focus $w.buttons.save"
+	bind $w <Key-Escape> "destroy $w"
+	bind $w <Key-Return> [list do_save_config $w]
+	wm title $w "[appname] ([reponame]): Options"
+	tkwait window $w
+}
+
+proc do_restore_defaults {} {
+	global font_descs default_config repo_config
+	global repo_config_new global_config_new
+
+	foreach name [array names default_config] {
+		set repo_config_new($name) $default_config($name)
+		set global_config_new($name) $default_config($name)
+	}
+
+	foreach option $font_descs {
+		set name [lindex $option 0]
+		set repo_config(gui.$name) $default_config(gui.$name)
+	}
+	apply_config
+
+	foreach option $font_descs {
+		set name [lindex $option 0]
+		set font [lindex $option 1]
+		set global_config_new(gui.$font^^family) \
+			[font configure $font -family]
+		set global_config_new(gui.$font^^size) \
+			[font configure $font -size]
+	}
+}
+
+proc do_save_config {w} {
+	if {[catch {save_config} err]} {
+		error_popup "Failed to completely save options:\n\n$err"
+	}
+	reshow_diff
+	destroy $w
+}

lib/remote.tcl

@@ -0,0 +1,211 @@
+# 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
+	foreach spec $tracking_branches {
+		set t [lindex $spec 0]
+		if {$t eq $name || [string match $t $name]} {
+			return 1
+		}
+	}
+	return 0
+}
+
+proc all_tracking_branches {} {
+	global tracking_branches
+
+	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 {
+			lappend all $spec
+		}
+	}
+
+	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 -index 0 -unique $all]
+}
+
+proc load_all_remotes {} {
+	global repo_config
+	global all_remotes tracking_branches some_heads_tracking
+	global remote_url
+
+	set some_heads_tracking 0
+	set all_remotes [list]
+	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 \
+			-types f \
+			-tails \
+			-nocomplain \
+			-directory $rm_dir *]
+
+		foreach name $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 {[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
+					}
+					if {[string equal -length $rh_len $rh_str $dst]} {
+						set some_heads_tracking 1
+					}
+					lappend trck [list $dst $name $src]
+				}
+				close $fd
+			}
+		}
+	}
+
+	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 {[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
+			}
+			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]
+}
+
+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)}]} {
+			if {![catch {set a $repo_config(remote.$r.fetch)}]} {
+				set enable 1
+			}
+		} else {
+			catch {
+				set fd [open [gitdir remotes $r] r]
+				while {[gets $fd n] >= 0} {
+					if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
+						set enable 1
+						break
+					}
+				}
+				close $fd
+			}
+		}
+
+		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 {} {
+	global all_remotes repo_config
+
+	set m .mbar.push
+	set fast_count 0
+	foreach r $all_remotes {
+		set enable 0
+		if {![catch {set a $repo_config(remote.$r.url)}]} {
+			if {![catch {set a $repo_config(remote.$r.push)}]} {
+				set enable 1
+			}
+		} else {
+			catch {
+				set fd [open [gitdir remotes $r] r]
+				while {[gets $fd n] >= 0} {
+					if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
+						set enable 1
+						break
+					}
+				}
+				close $fd
+			}
+		}
+
+		if {$enable} {
+			if {!$fast_count} {
+				$m add separator
+			}
+			$m add command \
+				-label "Push to $r..." \
+				-command [list push_to $r]
+			incr fast_count
+		}
+	}
+}

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}
+}
+
+}

lib/shortcut.tcl

@@ -0,0 +1,152 @@
+# git-gui desktop icon creators
+# Copyright (C) 2006, 2007 Shawn Pearce
+
+proc do_windows_shortcut {} {
+	global argv0
+
+	set fn [tk_getSaveFile \
+		-parent . \
+		-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 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=$ge;%PATH%"
+				puts $fd "@SET GIT_DIR=[file normalize [gitdir]]"
+				puts -nonewline $fd "@\"[info nameofexecutable]\""
+				puts $fd " \"[file normalize $argv0]\""
+				close $fd
+			} err]} {
+			error_popup "Cannot write script:\n\n$err"
+		}
+	}
+}
+
+proc do_cygwin_shortcut {} {
+	global argv0
+
+	if {[catch {
+		set desktop [exec cygpath \
+			--windows \
+			--absolute \
+			--long-name \
+			--desktop]
+		}]} {
+			set desktop .
+	}
+	set fn [tk_getSaveFile \
+		-parent . \
+		-title "[appname] ([reponame]): Create Desktop Icon" \
+		-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 \
+					--windows \
+					--absolute \
+					/bin/sh.exe]
+				set me [exec cygpath \
+					--unix \
+					--absolute \
+					$argv0]
+				set gd [exec cygpath \
+					--unix \
+					--absolute \
+					[gitdir]]
+				puts $fd "@ECHO Entering [reponame]"
+				puts $fd "@ECHO Starting git-gui... please wait..."
+				puts -nonewline $fd "@\"$sh\" --login -c \""
+				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"
+		}
+	}
+}
+
+proc do_macosx_app {} {
+	global argv0 env
+
+	set fn [tk_getSaveFile \
+		-parent . \
+		-title "[appname] ([reponame]): Create Desktop Icon" \
+		-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]
+				set exe [file join $MacOS git-gui]
+
+				file mkdir $MacOS
+
+				set fd [open [file join $Contents Info.plist] w]
+				puts $fd {<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+	<key>CFBundleDevelopmentRegion</key>
+	<string>English</string>
+	<key>CFBundleExecutable</key>
+	<string>git-gui</string>
+	<key>CFBundleIdentifier</key>
+	<string>org.spearce.git-gui</string>
+	<key>CFBundleInfoDictionaryVersion</key>
+	<string>6.0</string>
+	<key>CFBundlePackageType</key>
+	<string>APPL</string>
+	<key>CFBundleSignature</key>
+	<string>????</string>
+	<key>CFBundleVersion</key>
+	<string>1.0</string>
+	<key>NSPrincipalClass</key>
+	<string>NSApplication</string>
+</dict>
+</plist>}
+				close $fd
+
+				set fd [open $exe w]
+				puts $fd "#!/bin/sh"
+				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=[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
+			} err]} {
+			error_popup "Cannot write icon:\n\n$err"
+		}
+	}
+}

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
+	}
+}
+
+}

lib/transport.tcl

@@ -0,0 +1,174 @@
+# git-gui transport (fetch/push) support
+# Copyright (C) 2006, 2007 Shawn Pearce
+
+proc fetch_from {remote} {
+	set w [console::new \
+		"fetch $remote" \
+		"Fetching new changes from $remote"]
+	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} {
+	set w [console::new \
+		"push $remote" \
+		"Pushing changes to $remote"]
+	set cmd [list git push]
+	lappend cmd -v
+	lappend cmd $remote
+	console::exec $w $cmd
+}
+
+proc start_push_anywhere_action {w} {
+	global push_urltype push_remote push_url push_thin push_tags
+
+	set r_url {}
+	switch -- $push_urltype {
+	remote {set r_url $push_remote}
+	url {set r_url $push_url}
+	}
+	if {$r_url eq {}} return
+
+	set cmd [list git push]
+	lappend cmd -v
+	if {$push_thin} {
+		lappend cmd --thin
+	}
+	if {$push_tags} {
+		lappend cmd --tags
+	}
+	lappend cmd $r_url
+	set cnt 0
+	foreach i [$w.source.l curselection] {
+		set b [$w.source.l get $i]
+		lappend cmd "refs/heads/$b:refs/heads/$b"
+		incr cnt
+	}
+	if {$cnt == 0} {
+		return
+	} elseif {$cnt == 1} {
+		set unit branch
+	} else {
+		set unit branches
+	}
+
+	set cons [console::new \
+		"push $r_url" \
+		"Pushing $cnt $unit to $r_url"]
+	console::exec $cons $cmd
+	destroy $w
+}
+
+trace add variable push_remote write \
+	[list radio_selector push_urltype remote]
+
+proc do_push_anywhere {} {
+	global all_remotes current_branch
+	global push_urltype push_remote push_url push_thin push_tags
+
+	set w .push_setup
+	toplevel $w
+	wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
+
+	label $w.header -text {Push Branches} -font font_uibold
+	pack $w.header -side top -fill x
+
+	frame $w.buttons
+	button $w.buttons.create -text Push \
+		-default active \
+		-command [list start_push_anywhere_action $w]
+	pack $w.buttons.create -side right
+	button $w.buttons.cancel -text {Cancel} \
+		-default normal \
+		-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.source -text {Source Branches}
+	listbox $w.source.l \
+		-height 10 \
+		-width 70 \
+		-selectmode extended \
+		-yscrollcommand [list $w.source.sby set]
+	foreach h [load_all_heads] {
+		$w.source.l insert end $h
+		if {$h eq $current_branch} {
+			$w.source.l select set end
+		}
+	}
+	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
+
+	labelframe $w.dest -text {Destination Repository}
+	if {$all_remotes ne {}} {
+		radiobutton $w.dest.remote_r \
+			-text {Remote:} \
+			-value remote \
+			-variable push_urltype
+		eval tk_optionMenu $w.dest.remote_m push_remote $all_remotes
+		grid $w.dest.remote_r $w.dest.remote_m -sticky w
+		if {[lsearch -sorted -exact $all_remotes origin] != -1} {
+			set push_remote origin
+		} else {
+			set push_remote [lindex $all_remotes 0]
+		}
+		set push_urltype remote
+	} else {
+		set push_urltype url
+	}
+	radiobutton $w.dest.url_r \
+		-text {Arbitrary URL:} \
+		-value url \
+		-variable push_urltype
+	entry $w.dest.url_t \
+		-borderwidth 1 \
+		-relief sunken \
+		-width 50 \
+		-textvariable push_url \
+		-validate key \
+		-validatecommand {
+			if {%d == 1 && [regexp {\s} %S]} {return 0}
+			if {%d == 1 && [string length %S] > 0} {
+				set push_urltype url
+			}
+			return 1
+		}
+	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.options -text {Transfer Options}
+	checkbutton $w.options.thin \
+		-text {Use thin pack (for slow network connections)} \
+		-variable push_thin
+	grid $w.options.thin -columnspan 2 -sticky w
+	checkbutton $w.options.tags \
+		-text {Include tags} \
+		-variable push_tags
+	grid $w.options.tags -columnspan 2 -sticky w
+	grid columnconfigure $w.options 1 -weight 1
+	pack $w.options -anchor nw -fill x -pady 5 -padx 5
+
+	set push_url {}
+	set push_thin 0
+	set push_tags 0
+
+	bind $w <Visibility> "grab $w; focus $w.buttons.create"
+	bind $w <Key-Escape> "destroy $w"
+	bind $w <Key-Return> [list start_push_anywhere_action $w]
+	wm title $w "[appname] ([reponame]): Push"
+	tkwait window $w
+}