Commits

Anonymous committed b9dcf84 Merge

Merge commit 'git-gui/master'

* commit 'git-gui/master': (36 commits)
git-gui: Change prior tree SHA-1 verification to use git_read
git-gui: Include a space in Cygwin shortcut command lines
git-gui: Use sh.exe in Cygwin shortcuts
git-gui: Paper bag fix for Cygwin shortcut creation
git-gui: Improve the Windows and Mac OS X shortcut creators
git-gui: Teach console widget to use git_read
git-gui: Perform our own magic shbang detection on Windows
git-gui: Treat `git version` as `git --version`
git-gui: Assume unfound commands are known by git wrapper
git-gui: Correct gitk installation location
git-gui: Always use absolute path to all git executables
git-gui: Show a progress meter for checking out files
git-gui: Change the main window progress bar to use status_bar
git-gui: Extract blame viewer status bar into mega-widget
git-gui: Allow double-click in checkout dialog to start checkout
git-gui: Default selection to first matching ref
git-gui: Unabbreviate commit SHA-1s prior to display
git-gui: Refactor branch switch to support detached head
git-gui: Refactor our ui_status_value update technique
git-gui: Better handling of detached HEAD
...

  • Participants
  • Parent commits 237ce83, b215883

Comments (0)

Files changed (23)

File git-gui/git-gui.sh

 set _gitexec {}
 set _reponame {}
 set _iscygwin {}
+set _search_path {}
 
 proc appname {} {
 	global _appname
 	if {$args eq {}} {
 		return $_gitdir
 	}
-	return [eval [concat [list file join $_gitdir] $args]]
+	return [eval [list file join $_gitdir] $args]
 }
 
 proc gitexec {args} {
 		if {[catch {set _gitexec [git --exec-path]} err]} {
 			error "Git not installed?\n\n$err"
 		}
+		if {[is_Cygwin]} {
+			set _gitexec [exec cygpath \
+				--windows \
+				--absolute \
+				$_gitexec]
+		} else {
+			set _gitexec [file normalize $_gitexec]
+		}
 	}
 	if {$args eq {}} {
 		return $_gitexec
 	}
-	return [eval [concat [list file join $_gitexec] $args]]
+	return [eval [list file join $_gitexec] $args]
 }
 
 proc reponame {} {
 	array unset global_config
 	if {$include_global} {
 		catch {
-			set fd_rc [open "| git config --global --list" r]
+			set fd_rc [git_read config --global --list]
 			while {[gets $fd_rc line] >= 0} {
 				if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
 					if {[is_many_config $name]} {
 
 	array unset repo_config
 	catch {
-		set fd_rc [open "| git config --list" r]
+		set fd_rc [git_read config --list]
 		while {[gets $fd_rc line] >= 0} {
 			if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
 				if {[is_many_config $name]} {
 ##
 ## handy utils
 
+proc _git_cmd {name} {
+	global _git_cmd_path
+
+	if {[catch {set v $_git_cmd_path($name)}]} {
+		switch -- $name {
+		  version   -
+		--version   -
+		--exec-path { return [list $::_git $name] }
+		}
+
+		set p [gitexec git-$name$::_search_exe]
+		if {[file exists $p]} {
+			set v [list $p]
+		} elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
+			# Try to determine what sort of magic will make
+			# git-$name go and do its thing, because native
+			# Tcl on Windows doesn't know it.
+			#
+			set p [gitexec git-$name]
+			set f [open $p r]
+			set s [gets $f]
+			close $f
+
+			switch -glob -- $s {
+			#!*sh     { set i sh     }
+			#!*perl   { set i perl   }
+			#!*python { set i python }
+			default   { error "git-$name is not supported: $s" }
+			}
+
+			upvar #0 _$i interp
+			if {![info exists interp]} {
+				set interp [_which $i]
+			}
+			if {$interp eq {}} {
+				error "git-$name requires $i (not in PATH)"
+			}
+			set v [list $interp $p]
+		} else {
+			# Assume it is builtin to git somehow and we
+			# aren't actually able to see a file for it.
+			#
+			set v [list $::_git $name]
+		}
+		set _git_cmd_path($name) $v
+	}
+	return $v
+}
+
+proc _which {what} {
+	global env _search_exe _search_path
+
+	if {$_search_path eq {}} {
+		if {[is_Cygwin]} {
+			set _search_path [split [exec cygpath \
+				--windows \
+				--path \
+				--absolute \
+				$env(PATH)] {;}]
+			set _search_exe .exe
+		} elseif {[is_Windows]} {
+			set _search_path [split $env(PATH) {;}]
+			set _search_exe .exe
+		} else {
+			set _search_path [split $env(PATH) :]
+			set _search_exe {}
+		}
+	}
+
+	foreach p $_search_path {
+		set p [file join $p $what$_search_exe]
+		if {[file exists $p]} {
+			return [file normalize $p]
+		}
+	}
+	return {}
+}
+
 proc git {args} {
-	return [eval exec git $args]
+	set opt [list exec]
+
+	while {1} {
+		switch -- [lindex $args 0] {
+		--nice {
+			global _nice
+			if {$_nice ne {}} {
+				lappend opt $_nice
+			}
+		}
+
+		default {
+			break
+		}
+
+		}
+
+		set args [lrange $args 1 end]
+	}
+
+	set cmdp [_git_cmd [lindex $args 0]]
+	set args [lrange $args 1 end]
+
+	return [eval $opt $cmdp $args]
+}
+
+proc _open_stdout_stderr {cmd} {
+	if {[catch {
+			set fd [open $cmd r]
+		} err]} {
+		if {   [lindex $cmd end] eq {2>@1}
+		    && $err eq {can not find channel named "1"}
+			} {
+			# Older versions of Tcl 8.4 don't have this 2>@1 IO
+			# redirect operator.  Fallback to |& cat for those.
+			# The command was not actually started, so its safe
+			# to try to start it a second time.
+			#
+			set fd [open [concat \
+				[lrange $cmd 0 end-1] \
+				[list |& cat] \
+				] r]
+		} else {
+			error $err
+		}
+	}
+	return $fd
+}
+
+proc git_read {args} {
+	set opt [list |]
+
+	while {1} {
+		switch -- [lindex $args 0] {
+		--nice {
+			global _nice
+			if {$_nice ne {}} {
+				lappend opt $_nice
+			}
+		}
+
+		--stderr {
+			lappend args 2>@1
+		}
+
+		default {
+			break
+		}
+
+		}
+
+		set args [lrange $args 1 end]
+	}
+
+	set cmdp [_git_cmd [lindex $args 0]]
+	set args [lrange $args 1 end]
+
+	return [_open_stdout_stderr [concat $opt $cmdp $args]]
+}
+
+proc git_write {args} {
+	set opt [list |]
+
+	while {1} {
+		switch -- [lindex $args 0] {
+		--nice {
+			global _nice
+			if {$_nice ne {}} {
+				lappend opt $_nice
+			}
+		}
+
+		default {
+			break
+		}
+
+		}
+
+		set args [lrange $args 1 end]
+	}
+
+	set cmdp [_git_cmd [lindex $args 0]]
+	set args [lrange $args 1 end]
+
+	return [open [concat $opt $cmdp $args] w]
 }
 
-proc current-branch {} {
-	set ref {}
+proc sq {value} {
+	regsub -all ' $value "'\\''" value
+	return "'$value'"
+}
+
+proc load_current_branch {} {
+	global current_branch is_detached
+
 	set fd [open [gitdir HEAD] r]
-	if {[gets $fd ref] <16
-	 || ![regsub {^ref: refs/heads/} $ref {} ref]} {
+	if {[gets $fd ref] < 1} {
 		set ref {}
 	}
 	close $fd
-	return $ref
+
+	set pfx {ref: refs/heads/}
+	set len [string length $pfx]
+	if {[string equal -length $len $pfx $ref]} {
+		# We're on a branch.  It might not exist.  But
+		# HEAD looks good enough to be a branch.
+		#
+		set current_branch [string range $ref $len end]
+		set is_detached 0
+	} else {
+		# Assume this is a detached head.
+		#
+		set current_branch HEAD
+		set is_detached 1
+	}
 }
 
 auto_load tk_optionMenu
 
 ######################################################################
 ##
-## version check
+## find git
+
+set _git  [_which git]
+if {$_git eq {}} {
+	catch {wm withdraw .}
+	error_popup "Cannot find git in PATH."
+	exit 1
+}
+set _nice [_which nice]
 
-set req_maj 1
-set req_min 5
+######################################################################
+##
+## version check
 
-if {[catch {set v [git --version]} err]} {
+if {[catch {set _git_version [git --version]} err]} {
 	catch {wm withdraw .}
 	error_popup "Cannot determine Git version:
 
 $err
 
-[appname] requires Git $req_maj.$req_min or later."
+[appname] requires Git 1.5.0 or later."
 	exit 1
 }
-if {[regexp {^git version (\d+)\.(\d+)} $v _junk act_maj act_min]} {
-	if {$act_maj < $req_maj
-		|| ($act_maj == $req_maj && $act_min < $req_min)} {
-		catch {wm withdraw .}
-		error_popup "[appname] requires Git $req_maj.$req_min or later.
+if {![regsub {^git version } $_git_version {} _git_version]} {
+	catch {wm withdraw .}
+	error_popup "Cannot parse Git version string:\n\n$_git_version"
+	exit 1
+}
+regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
+regsub {\.rc[0-9]+$} $_git_version {} _git_version
 
-You are using $v."
-		exit 1
+proc git-version {args} {
+	global _git_version
+
+	switch [llength $args] {
+	0 {
+		return $_git_version
 	}
-} else {
+
+	2 {
+		set op [lindex $args 0]
+		set vr [lindex $args 1]
+		set cm [package vcompare $_git_version $vr]
+		return [expr $cm $op 0]
+	}
+
+	4 {
+		set type [lindex $args 0]
+		set name [lindex $args 1]
+		set parm [lindex $args 2]
+		set body [lindex $args 3]
+
+		if {($type ne {proc} && $type ne {method})} {
+			error "Invalid arguments to git-version"
+		}
+		if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
+			error "Last arm of $type $name must be default"
+		}
+
+		foreach {op vr cb} [lrange $body 0 end-2] {
+			if {[git-version $op $vr]} {
+				return [uplevel [list $type $name $parm $cb]]
+			}
+		}
+
+		return [uplevel [list $type $name $parm [lindex $body end]]]
+	}
+
+	default {
+		error "git-version >= x"
+	}
+
+	}
+}
+
+if {[git-version < 1.5]} {
 	catch {wm withdraw .}
-	error_popup "Cannot parse Git version string:\n\n$v"
+	error_popup "[appname] requires Git 1.5.0 or later.
+
+You are using [git-version]:
+
+[git --version]"
 	exit 1
 }
-unset -nocomplain v _junk act_maj act_min req_maj req_min
 
 ######################################################################
 ##
 set current_diff_path {}
 set current_diff_side {}
 set diff_actions [list]
-set ui_status_value {Initializing...}
 
 set HEAD {}
 set PARENT {}
 set commit_type {}
 set empty_tree {}
 set current_branch {}
+set is_detached 0
 set current_diff_path {}
 set selected_commit_type new
 
 
 	set mh [list]
 
-	set current_branch [current-branch]
+	load_current_branch
 	if {[catch {set hd [git rev-parse --verify HEAD]}]} {
 		set hd {}
 		set ct initial
 
 proc rescan {after {honor_trustmtime 1}} {
 	global HEAD PARENT MERGE_HEAD commit_type
-	global ui_index ui_workdir ui_status_value ui_comm
+	global ui_index ui_workdir ui_comm
 	global rescan_active file_states
 	global repo_config
 
 		$ui_comm edit modified false
 	}
 
-	if {[is_enabled branch]} {
-		load_all_heads
-		populate_branch_menu
-	}
-
 	if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
 		rescan_stage2 {} $after
 	} else {
 		set rescan_active 1
-		set ui_status_value {Refreshing file status...}
-		set cmd [list git update-index]
-		lappend cmd -q
-		lappend cmd --unmerged
-		lappend cmd --ignore-missing
-		lappend cmd --refresh
-		set fd_rf [open "| $cmd" r]
+		ui_status {Refreshing file status...}
+		set fd_rf [git_read update-index \
+			-q \
+			--unmerged \
+			--ignore-missing \
+			--refresh \
+			]
 		fconfigure $fd_rf -blocking 0 -translation binary
 		fileevent $fd_rf readable \
 			[list rescan_stage2 $fd_rf $after]
 }
 
 proc rescan_stage2 {fd after} {
-	global ui_status_value
 	global rescan_active buf_rdi buf_rdf buf_rlo
 
 	if {$fd ne {}} {
 		close $fd
 	}
 
-	set ls_others [list | git ls-files --others -z \
-		--exclude-per-directory=.gitignore]
+	set ls_others [list --exclude-per-directory=.gitignore]
 	set info_exclude [gitdir info exclude]
 	if {[file readable $info_exclude]} {
 		lappend ls_others "--exclude-from=$info_exclude"
 	set buf_rlo {}
 
 	set rescan_active 3
-	set ui_status_value {Scanning for modified files ...}
-	set fd_di [open "| git diff-index --cached -z [PARENT]" r]
-	set fd_df [open "| git diff-files -z" r]
-	set fd_lo [open $ls_others r]
+	ui_status {Scanning for modified files ...}
+	set fd_di [git_read diff-index --cached -z [PARENT]]
+	set fd_df [git_read diff-files -z]
+	set fd_lo [eval git_read ls-files --others -z $ls_others]
 
 	fconfigure $fd_di -blocking 0 -translation binary -encoding binary
 	fconfigure $fd_df -blocking 0 -translation binary -encoding binary
 	return $r
 }
 
+proc ui_status {msg} {
+	$::main_status show $msg
+}
+
+proc ui_ready {{test {}}} {
+	$::main_status show {Ready.} $test
+}
+
 proc escape_path {path} {
 	regsub -all {\\} $path "\\\\" path
 	regsub -all "\n" $path "\\n" path
 set starting_gitk_msg {Starting gitk... please wait...}
 
 proc do_gitk {revs} {
-	global env ui_status_value starting_gitk_msg
-
 	# -- Always start gitk through whatever we were loaded with.  This
 	#    lets us bypass using shell process on Windows systems.
 	#
-	set cmd [list [info nameofexecutable]]
-	lappend cmd [gitexec gitk]
-	if {$revs ne {}} {
-		append cmd { }
-		append cmd $revs
-	}
-
-	if {[catch {eval exec $cmd &} err]} {
-		error_popup "Failed to start gitk:\n\n$err"
+	set exe [file join [file dirname $::_git] gitk]
+	set cmd [list [info nameofexecutable] $exe]
+	if {! [file exists $exe]} {
+		error_popup "Unable to start gitk:\n\n$exe does not exist"
 	} else {
-		set ui_status_value $starting_gitk_msg
+		eval exec $cmd $revs &
+		ui_status $::starting_gitk_msg
 		after 10000 {
-			if {$ui_status_value eq $starting_gitk_msg} {
-				set ui_status_value {Ready.}
-			}
+			ui_ready $starting_gitk_msg
 		}
 	}
 }
 }
 
 proc do_rescan {} {
-	rescan {set ui_status_value {Ready.}}
+	rescan ui_ready
 }
 
 proc do_commit {} {
 			update_indexinfo \
 				"Unstaging [short_path $path] from commit" \
 				[list $path] \
-				[concat $after {set ui_status_value {Ready.}}]
+				[concat $after [list ui_ready]]
 		} elseif {$w eq $ui_workdir} {
 			update_index \
 				"Adding [short_path $path]" \
 				[list $path] \
-				[concat $after {set ui_status_value {Ready.}}]
+				[concat $after [list ui_ready]]
 		}
 	} else {
 		show_diff $path $w $lno
 set default_config(user.name) {}
 set default_config(user.email) {}
 
+set default_config(gui.matchtrackingbranch) false
 set default_config(gui.pruneduringfetch) false
 set default_config(gui.trustmtime) false
 set default_config(gui.diffcontext) 5
 	menu .mbar.branch
 
 	.mbar.branch add command -label {Create...} \
-		-command do_create_branch \
+		-command branch_create::dialog \
 		-accelerator $M1T-N
 	lappend disable_on_lock [list .mbar.branch entryconf \
 		[.mbar.branch index last] -state]
 
+	.mbar.branch add command -label {Checkout...} \
+		-command branch_checkout::dialog \
+		-accelerator $M1T-O
+	lappend disable_on_lock [list .mbar.branch entryconf \
+		[.mbar.branch index last] -state]
+
 	.mbar.branch add command -label {Rename...} \
 		-command branch_rename::dialog
 	lappend disable_on_lock [list .mbar.branch entryconf \
 		[.mbar.branch index last] -state]
 
 	.mbar.branch add command -label {Delete...} \
-		-command do_delete_branch
+		-command branch_delete::dialog
 	lappend disable_on_lock [list .mbar.branch entryconf \
 		[.mbar.branch index last] -state]
 
 
 	menu .mbar.push
 	.mbar.push add command -label {Push...} \
-		-command do_push_anywhere
+		-command do_push_anywhere \
+		-accelerator $M1T-P
 	.mbar.push add command -label {Delete...} \
 		-command remote_branch_delete::dialog
 }
 	#
 	if {[is_Cygwin] && [file exists /usr/local/miga/lib/gui-miga]} {
 	proc do_miga {} {
-		global ui_status_value
 		if {![lock_index update]} return
 		set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
 		set miga_fd [open "|$cmd" r]
 		fconfigure $miga_fd -blocking 0
 		fileevent $miga_fd readable [list miga_done $miga_fd]
-		set ui_status_value {Running miga...}
+		ui_status {Running miga...}
 	}
 	proc miga_done {fd} {
 		read $fd 512
 		if {[eof $fd]} {
 			close $fd
 			unlock_index
-			rescan [list set ui_status_value {Ready.}]
+			rescan ui_ready
 		}
 	}
 	.mbar add cascade -label Tools -menu .mbar.tools
 browser {
 	set subcommand_args {rev?}
 	switch [llength $argv] {
-	0 { set current_branch [current-branch] }
-	1 { set current_branch [lindex $argv 0] }
+	0 { load_current_branch }
+	1 {
+		set current_branch [lindex $argv 0]
+		if {[regexp {^[0-9a-f]{1,39}$} $current_branch]} {
+			if {[catch {
+					set current_branch \
+					[git rev-parse --verify $current_branch]
+				} err]} {
+				puts stderr $err
+				exit 1
+			}
+		}
+	}
 	default usage
 	}
 	browser::new $current_branch
 	unset is_path
 
 	if {$head eq {}} {
-		set current_branch [current-branch]
+		load_current_branch
 	} else {
+		if {[regexp {^[0-9a-f]{1,39}$} $head]} {
+			if {[catch {
+					set head [git rev-parse --verify $head]
+				} err]} {
+				puts stderr $err
+				exit 1
+			}
+		}
 		set current_branch $head
 	}
 
 lappend disable_on_lock \
 	{.vpane.lower.commarea.buttons.commit conf -state}
 
+button .vpane.lower.commarea.buttons.push -text {Push} \
+	-command do_push_anywhere
+pack .vpane.lower.commarea.buttons.push -side top -fill x
+
 # -- Commit Message Buffer
 #
 frame .vpane.lower.commarea.buffer
 
 # -- Status Bar
 #
-label .status -textvariable ui_status_value \
-	-anchor w \
-	-justify left \
-	-borderwidth 1 \
-	-relief sunken
+set main_status [::status_bar::new .status]
 pack .status -anchor w -side bottom -fill x
+$main_status show {Initializing...}
 
 # -- Load geometry
 #
 bind $ui_diff <Button-1>   {focus %W}
 
 if {[is_enabled branch]} {
-	bind . <$M1B-Key-n> do_create_branch
-	bind . <$M1B-Key-N> do_create_branch
+	bind . <$M1B-Key-n> branch_create::dialog
+	bind . <$M1B-Key-N> branch_create::dialog
+	bind . <$M1B-Key-o> branch_checkout::dialog
+	bind . <$M1B-Key-O> branch_checkout::dialog
+}
+if {[is_enabled transport]} {
+	bind . <$M1B-Key-p> do_push_anywhere
+	bind . <$M1B-Key-P> do_push_anywhere
 }
 
-bind all <Key-F5> do_rescan
-bind all <$M1B-Key-r> do_rescan
-bind all <$M1B-Key-R> do_rescan
+bind .   <Key-F5>     do_rescan
+bind .   <$M1B-Key-r> do_rescan
+bind .   <$M1B-Key-R> do_rescan
 bind .   <$M1B-Key-s> do_signoff
 bind .   <$M1B-Key-S> do_signoff
 bind .   <$M1B-Key-i> do_add_all
 #
 if {[is_enabled transport]} {
 	load_all_remotes
-	load_all_heads
 
-	populate_branch_menu
 	populate_fetch_menu
 	populate_push_menu
 }

File git-gui/lib/blame.tcl

 field w_asim     ; # text column: annotations (simple computation)
 field w_file     ; # text column: actual file data
 field w_cviewer  ; # pane showing commit message
-field status     ; # text variable bound to status bar
+field status     ; # status mega-widget instance
 field old_height ; # last known height of $w.file_pane
 
 # Tk UI colors
 	#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
 	pack $w.file_pane.cm.sbx -side bottom -fill x
 	pack $w_cviewer -expand 1 -fill both
 
-	frame $w.status \
-		-borderwidth 1 \
-		-relief sunken
-	label $w.status.l \
-		-textvariable @status \
-		-anchor w \
-		-justify left
-	pack $w.status.l -side left
+	set status [::status_bar::new $w.status]
 
 	menu $w.ctxm -tearoff 0
 	$w.ctxm add command \
 
 	set req_w [winfo reqwidth  $top]
 	set req_h [winfo reqheight $top]
+	set scr_h [expr {[winfo screenheight $top] - 100}]
 	if {$req_w < 600} {set req_w 600}
-	if {$req_h < 400} {set req_h 400}
+	if {$req_h < $scr_h} {set req_h $scr_h}
 	set g "${req_w}x${req_h}"
 	wm geometry $top $g
 	update
 		set total_lines 0
 	}
 
-	if {[winfo exists $w.status.c]} {
-		$w.status.c coords bar 0 0 0 20
-	} else {
-		canvas $w.status.c \
-			-width 100 \
-			-height [expr {int([winfo reqheight $w.status.l] * 0.6)}] \
-			-borderwidth 1 \
-			-relief groove \
-			-highlightt 0
-		$w.status.c create rectangle 0 0 0 20 -tags bar -fill navy
-		pack $w.status.c -side right
-	}
-
 	if {$history eq {}} {
 		$w_back conf -state disabled
 	} else {
 	set amov_data [list [list]]
 	set asim_data [list [list]]
 
-	set status "Loading $commit:[escape_path $path]..."
+	$status show "Reading $commit:[escape_path $path]..."
 	$w_path conf -text [escape_path $path]
 	if {$commit eq {}} {
 		set fd [open $path r]
 	} else {
-		set cmd [list git cat-file blob "$commit:$path"]
-		set fd [open "| $cmd" r]
+		set fd [git_read cat-file blob "$commit:$path"]
 	}
 	fconfigure $fd -blocking 0 -translation lf -encoding binary
 	fileevent $fd readable [cb _read_file $fd $jump]
 } ifdeleted { catch {close $fd} }
 
 method _exec_blame {cur_w cur_d options cur_s} {
-	set cmd [list]
-	if {![is_Windows] || [is_Cygwin]} {
-		lappend cmd nice
-	}
-	lappend cmd git blame
-	set cmd [concat $cmd $options]
-	lappend cmd --incremental
+	lappend options --incremental
 	if {$commit eq {}} {
-		lappend cmd --contents $path
+		lappend options --contents $path
 	} else {
-		lappend cmd $commit
+		lappend options $commit
 	}
-	lappend cmd -- $path
-	set fd [open "| $cmd" r]
+	lappend options -- $path
+	set fd [eval git_read --nice blame $options]
 	fconfigure $fd -blocking 0 -translation lf -encoding binary
-	fileevent $fd readable [cb _read_blame $fd $cur_w $cur_d $cur_s]
+	fileevent $fd readable [cb _read_blame $fd $cur_w $cur_d]
 	set current_fd $fd
 	set blame_lines 0
-	_status $this $cur_s
+
+	$status start \
+		"Loading$cur_s annotations..." \
+		{lines annotated}
 }
 
-method _read_blame {fd cur_w cur_d cur_s} {
+method _read_blame {fd cur_w cur_d} {
 	upvar #0 $cur_d line_data
 	variable group_colors
+	variable original_options
 
 	if {$fd ne $current_fd} {
 		catch {close $fd}
 			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
 		close $fd
 		if {$cur_w eq $w_asim} {
 			_exec_blame $this $w_amov @amov_data \
-				[list -M -C -C] \
+				$original_options \
 				{ original location}
 		} else {
 			set current_fd {}
-			set status {Annotation complete.}
-			destroy $w.status.c
+			$status stop {Annotation complete.}
 		}
 	} else {
-		_status $this $cur_s
+		$status update $blame_lines $total_lines
 	}
 } ifdeleted { catch {close $fd} }
 
-method _status {cur_s} {
-	set have  $blame_lines
-	set total $total_lines
-	set pdone 0
-	if {$total} {set pdone [expr {100 * $have / $total}]}
-
-	set status [format \
-		"Loading%s annotations... %i of %i lines annotated (%2i%%)" \
-		$cur_s $have $total $pdone]
-	$w.status.c coords bar 0 0 $pdone 20
-}
-
 method _click {cur_w pos} {
 	set lno [lindex [split [$cur_w index $pos] .] 0]
 	_showcommit $this $cur_w $lno
 		if {[catch {set msg $header($cmit,message)}]} {
 			set msg {}
 			catch {
-				set fd [open "| git cat-file commit $cmit" r]
+				set fd [git_read cat-file commit $cmit]
 				fconfigure $fd -encoding binary -translation lf
 				if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
 					set enc utf-8

File git-gui/lib/branch.tcl

 # Copyright (C) 2006, 2007 Shawn Pearce
 
 proc load_all_heads {} {
-	global all_heads
+	global some_heads_tracking
 
+	set rh refs/heads
+	set rh_len [expr {[string length $rh] + 1}]
 	set all_heads [list]
-	set fd [open "| git for-each-ref --format=%(refname) refs/heads" r]
+	set fd [git_read for-each-ref --format=%(refname) $rh]
 	while {[gets $fd line] > 0} {
-		if {[is_tracking_branch $line]} continue
-		if {![regsub ^refs/heads/ $line {} name]} continue
-		lappend all_heads $name
+		if {!$some_heads_tracking || ![is_tracking_branch $line]} {
+			lappend all_heads [string range $line $rh_len end]
+		}
 	}
 	close $fd
 
-	set all_heads [lsort $all_heads]
+	return [lsort $all_heads]
 }
 
 proc load_all_tags {} {
 	set all_tags [list]
-	set fd [open "| git for-each-ref --format=%(refname) refs/tags" r]
+	set fd [git_read for-each-ref \
+		--sort=-taggerdate \
+		--format=%(refname) \
+		refs/tags]
 	while {[gets $fd line] > 0} {
 		if {![regsub ^refs/tags/ $line {} name]} continue
 		lappend all_tags $name
 	}
 	close $fd
-
-	return [lsort $all_tags]
-}
-
-proc populate_branch_menu {} {
-	global all_heads disable_on_lock
-
-	set m .mbar.branch
-	set last [$m index last]
-	for {set i 0} {$i <= $last} {incr i} {
-		if {[$m type $i] eq {separator}} {
-			$m delete $i last
-			set new_dol [list]
-			foreach a $disable_on_lock {
-				if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
-					lappend new_dol $a
-				}
-			}
-			set disable_on_lock $new_dol
-			break
-		}
-	}
-
-	if {$all_heads ne {}} {
-		$m add separator
-	}
-	foreach b $all_heads {
-		$m add radiobutton \
-			-label $b \
-			-command [list switch_branch $b] \
-			-variable current_branch \
-			-value $b
-		lappend disable_on_lock \
-			[list $m entryconf [$m index last] -state]
-	}
-}
-
-proc do_create_branch_action {w} {
-	global all_heads null_sha1 repo_config
-	global create_branch_checkout create_branch_revtype
-	global create_branch_head create_branch_trackinghead
-	global create_branch_name create_branch_revexp
-	global create_branch_tag
-
-	set newbranch $create_branch_name
-	if {$newbranch eq {}
-		|| $newbranch eq $repo_config(gui.newbranchtemplate)} {
-		tk_messageBox \
-			-icon error \
-			-type ok \
-			-title [wm title $w] \
-			-parent $w \
-			-message "Please supply a branch name."
-		focus $w.desc.name_t
-		return
-	}
-	if {![catch {git show-ref --verify -- "refs/heads/$newbranch"}]} {
-		tk_messageBox \
-			-icon error \
-			-type ok \
-			-title [wm title $w] \
-			-parent $w \
-			-message "Branch '$newbranch' already exists."
-		focus $w.desc.name_t
-		return
-	}
-	if {[catch {git check-ref-format "heads/$newbranch"}]} {
-		tk_messageBox \
-			-icon error \
-			-type ok \
-			-title [wm title $w] \
-			-parent $w \
-			-message "We do not like '$newbranch' as a branch name."
-		focus $w.desc.name_t
-		return
-	}
-
-	set rev {}
-	switch -- $create_branch_revtype {
-	head {set rev $create_branch_head}
-	tracking {set rev $create_branch_trackinghead}
-	tag {set rev $create_branch_tag}
-	expression {set rev $create_branch_revexp}
-	}
-	if {[catch {set cmt [git rev-parse --verify "${rev}^0"]}]} {
-		tk_messageBox \
-			-icon error \
-			-type ok \
-			-title [wm title $w] \
-			-parent $w \
-			-message "Invalid starting revision: $rev"
-		return
-	}
-	if {[catch {
-			git update-ref \
-				-m "branch: Created from $rev" \
-				"refs/heads/$newbranch" \
-				$cmt \
-				$null_sha1
-		} err]} {
-		tk_messageBox \
-			-icon error \
-			-type ok \
-			-title [wm title $w] \
-			-parent $w \
-			-message "Failed to create '$newbranch'.\n\n$err"
-		return
-	}
-
-	lappend all_heads $newbranch
-	set all_heads [lsort $all_heads]
-	populate_branch_menu
-	destroy $w
-	if {$create_branch_checkout} {
-		switch_branch $newbranch
-	}
+	return $all_tags
 }
 
 proc radio_selector {varname value args} {
 	upvar #0 $varname var
 	set var $value
 }
-
-trace add variable create_branch_head write \
-	[list radio_selector create_branch_revtype head]
-trace add variable create_branch_trackinghead write \
-	[list radio_selector create_branch_revtype tracking]
-trace add variable create_branch_tag write \
-	[list radio_selector create_branch_revtype tag]
-
-trace add variable delete_branch_head write \
-	[list radio_selector delete_branch_checktype head]
-trace add variable delete_branch_trackinghead write \
-	[list radio_selector delete_branch_checktype tracking]
-
-proc do_create_branch {} {
-	global all_heads current_branch repo_config
-	global create_branch_checkout create_branch_revtype
-	global create_branch_head create_branch_trackinghead
-	global create_branch_name create_branch_revexp
-	global create_branch_tag
-
-	set w .branch_editor
-	toplevel $w
-	wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
-
-	label $w.header -text {Create New Branch} \
-		-font font_uibold
-	pack $w.header -side top -fill x
-
-	frame $w.buttons
-	button $w.buttons.create -text Create \
-		-default active \
-		-command [list do_create_branch_action $w]
-	pack $w.buttons.create -side right
-	button $w.buttons.cancel -text {Cancel} \
-		-command [list destroy $w]
-	pack $w.buttons.cancel -side right -padx 5
-	pack $w.buttons -side bottom -fill x -pady 10 -padx 10
-
-	labelframe $w.desc -text {Branch Description}
-	label $w.desc.name_l -text {Name:}
-	entry $w.desc.name_t \
-		-borderwidth 1 \
-		-relief sunken \
-		-width 40 \
-		-textvariable create_branch_name \
-		-validate key \
-		-validatecommand {
-			if {%d == 1 && [regexp {[~^:?*\[\0- ]} %S]} {return 0}
-			return 1
-		}
-	grid $w.desc.name_l $w.desc.name_t -sticky we -padx {0 5}
-	grid columnconfigure $w.desc 1 -weight 1
-	pack $w.desc -anchor nw -fill x -pady 5 -padx 5
-
-	labelframe $w.from -text {Starting Revision}
-	if {$all_heads ne {}} {
-		radiobutton $w.from.head_r \
-			-text {Local Branch:} \
-			-value head \
-			-variable create_branch_revtype
-		eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
-		grid $w.from.head_r $w.from.head_m -sticky w
-	}
-	set all_trackings [all_tracking_branches]
-	if {$all_trackings ne {}} {
-		set create_branch_trackinghead [lindex $all_trackings 0]
-		radiobutton $w.from.tracking_r \
-			-text {Tracking Branch:} \
-			-value tracking \
-			-variable create_branch_revtype
-		eval tk_optionMenu $w.from.tracking_m \
-			create_branch_trackinghead \
-			$all_trackings
-		grid $w.from.tracking_r $w.from.tracking_m -sticky w
-	}
-	set all_tags [load_all_tags]
-	if {$all_tags ne {}} {
-		set create_branch_tag [lindex $all_tags 0]
-		radiobutton $w.from.tag_r \
-			-text {Tag:} \
-			-value tag \
-			-variable create_branch_revtype
-		eval tk_optionMenu $w.from.tag_m create_branch_tag $all_tags
-		grid $w.from.tag_r $w.from.tag_m -sticky w
-	}
-	radiobutton $w.from.exp_r \
-		-text {Revision Expression:} \
-		-value expression \
-		-variable create_branch_revtype
-	entry $w.from.exp_t \
-		-borderwidth 1 \
-		-relief sunken \
-		-width 50 \
-		-textvariable create_branch_revexp \
-		-validate key \
-		-validatecommand {
-			if {%d == 1 && [regexp {\s} %S]} {return 0}
-			if {%d == 1 && [string length %S] > 0} {
-				set create_branch_revtype expression
-			}
-			return 1
-		}
-	grid $w.from.exp_r $w.from.exp_t -sticky we -padx {0 5}
-	grid columnconfigure $w.from 1 -weight 1
-	pack $w.from -anchor nw -fill x -pady 5 -padx 5
-
-	labelframe $w.postActions -text {Post Creation Actions}
-	checkbutton $w.postActions.checkout \
-		-text {Checkout after creation} \
-		-variable create_branch_checkout
-	pack $w.postActions.checkout -anchor nw
-	pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
-
-	set create_branch_checkout 1
-	set create_branch_head $current_branch
-	set create_branch_revtype head
-	set create_branch_name $repo_config(gui.newbranchtemplate)
-	set create_branch_revexp {}
-
-	bind $w <Visibility> "
-		grab $w
-		$w.desc.name_t icursor end
-		focus $w.desc.name_t
-	"
-	bind $w <Key-Escape> "destroy $w"
-	bind $w <Key-Return> "do_create_branch_action $w;break"
-	wm title $w "[appname] ([reponame]): Create Branch"
-	tkwait window $w
-}
-
-proc do_delete_branch_action {w} {
-	global all_heads
-	global delete_branch_checktype delete_branch_head delete_branch_trackinghead
-
-	set check_rev {}
-	switch -- $delete_branch_checktype {
-	head {set check_rev $delete_branch_head}
-	tracking {set check_rev $delete_branch_trackinghead}
-	always {set check_rev {:none}}
-	}
-	if {$check_rev eq {:none}} {
-		set check_cmt {}
-	} elseif {[catch {set check_cmt [git rev-parse --verify "${check_rev}^0"]}]} {
-		tk_messageBox \
-			-icon error \
-			-type ok \
-			-title [wm title $w] \
-			-parent $w \
-			-message "Invalid check revision: $check_rev"
-		return
-	}
-
-	set to_delete [list]
-	set not_merged [list]
-	foreach i [$w.list.l curselection] {
-		set b [$w.list.l get $i]
-		if {[catch {set o [git rev-parse --verify $b]}]} continue
-		if {$check_cmt ne {}} {
-			if {$b eq $check_rev} continue
-			if {[catch {set m [git merge-base $o $check_cmt]}]} continue
-			if {$o ne $m} {
-				lappend not_merged $b
-				continue
-			}
-		}
-		lappend to_delete [list $b $o]
-	}
-	if {$not_merged ne {}} {
-		set msg "The following branches are not completely merged into $check_rev:
-
- - [join $not_merged "\n - "]"
-		tk_messageBox \
-			-icon info \
-			-type ok \
-			-title [wm title $w] \
-			-parent $w \
-			-message $msg
-	}
-	if {$to_delete eq {}} return
-	if {$delete_branch_checktype eq {always}} {
-		set msg {Recovering deleted branches is difficult.
-
-Delete the selected branches?}
-		if {[tk_messageBox \
-			-icon warning \
-			-type yesno \
-			-title [wm title $w] \
-			-parent $w \
-			-message $msg] ne yes} {
-			return
-		}
-	}
-
-	set failed {}
-	foreach i $to_delete {
-		set b [lindex $i 0]
-		set o [lindex $i 1]
-		if {[catch {git update-ref -d "refs/heads/$b" $o} err]} {
-			append failed " - $b: $err\n"
-		} else {
-			set x [lsearch -sorted -exact $all_heads $b]
-			if {$x >= 0} {
-				set all_heads [lreplace $all_heads $x $x]
-			}
-		}
-	}
-
-	if {$failed ne {}} {
-		tk_messageBox \
-			-icon error \
-			-type ok \
-			-title [wm title $w] \
-			-parent $w \
-			-message "Failed to delete branches:\n$failed"
-	}
-
-	set all_heads [lsort $all_heads]
-	populate_branch_menu
-	destroy $w
-}
-
-proc do_delete_branch {} {
-	global all_heads tracking_branches current_branch
-	global delete_branch_checktype delete_branch_head delete_branch_trackinghead
-
-	set w .branch_editor
-	toplevel $w
-	wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
-
-	label $w.header -text {Delete Local Branch} \
-		-font font_uibold
-	pack $w.header -side top -fill x
-
-	frame $w.buttons
-	button $w.buttons.create -text Delete \
-		-command [list do_delete_branch_action $w]
-	pack $w.buttons.create -side right
-	button $w.buttons.cancel -text {Cancel} \
-		-command [list destroy $w]
-	pack $w.buttons.cancel -side right -padx 5
-	pack $w.buttons -side bottom -fill x -pady 10 -padx 10
-
-	labelframe $w.list -text {Local Branches}
-	listbox $w.list.l \
-		-height 10 \
-		-width 70 \
-		-selectmode extended \
-		-yscrollcommand [list $w.list.sby set]
-	foreach h $all_heads {
-		if {$h ne $current_branch} {
-			$w.list.l insert end $h
-		}
-	}
-	scrollbar $w.list.sby -command [list $w.list.l yview]
-	pack $w.list.sby -side right -fill y
-	pack $w.list.l -side left -fill both -expand 1
-	pack $w.list -fill both -expand 1 -pady 5 -padx 5
-
-	labelframe $w.validate -text {Delete Only If}
-	radiobutton $w.validate.head_r \
-		-text {Merged Into Local Branch:} \
-		-value head \
-		-variable delete_branch_checktype
-	eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
-	grid $w.validate.head_r $w.validate.head_m -sticky w
-	set all_trackings [all_tracking_branches]
-	if {$all_trackings ne {}} {
-		set delete_branch_trackinghead [lindex $all_trackings 0]
-		radiobutton $w.validate.tracking_r \
-			-text {Merged Into Tracking Branch:} \
-			-value tracking \
-			-variable delete_branch_checktype
-		eval tk_optionMenu $w.validate.tracking_m \
-			delete_branch_trackinghead \
-			$all_trackings
-		grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
-	}
-	radiobutton $w.validate.always_r \
-		-text {Always (Do not perform merge checks)} \
-		-value always \
-		-variable delete_branch_checktype
-	grid $w.validate.always_r -columnspan 2 -sticky w
-	grid columnconfigure $w.validate 1 -weight 1
-	pack $w.validate -anchor nw -fill x -pady 5 -padx 5
-
-	set delete_branch_head $current_branch
-	set delete_branch_checktype head
-
-	bind $w <Visibility> "grab $w; focus $w"
-	bind $w <Key-Escape> "destroy $w"
-	wm title $w "[appname] ([reponame]): Delete Branch"
-	tkwait window $w
-}
-
-proc switch_branch {new_branch} {
-	global HEAD commit_type current_branch repo_config
-
-	if {![lock_index switch]} return
-
-	# -- Our in memory state should match the repository.
-	#
-	repository_state curType curHEAD curMERGE_HEAD
-	if {[string match amend* $commit_type]
-		&& $curType eq {normal}
-		&& $curHEAD eq $HEAD} {
-	} elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
-		info_popup {Last scanned state does not match repository state.
-
-Another Git program has modified this repository since the last scan.  A rescan must be performed before the current branch can be changed.
-
-The rescan will be automatically started now.
-}
-		unlock_index
-		rescan {set ui_status_value {Ready.}}
-		return
-	}
-
-	# -- Don't do a pointless switch.
-	#
-	if {$current_branch eq $new_branch} {
-		unlock_index
-		return
-	}
-
-	if {$repo_config(gui.trustmtime) eq {true}} {
-		switch_branch_stage2 {} $new_branch
-	} else {
-		set ui_status_value {Refreshing file status...}
-		set cmd [list git update-index]
-		lappend cmd -q
-		lappend cmd --unmerged
-		lappend cmd --ignore-missing
-		lappend cmd --refresh
-		set fd_rf [open "| $cmd" r]
-		fconfigure $fd_rf -blocking 0 -translation binary
-		fileevent $fd_rf readable \
-			[list switch_branch_stage2 $fd_rf $new_branch]
-	}
-}
-
-proc switch_branch_stage2 {fd_rf new_branch} {
-	global ui_status_value HEAD
-
-	if {$fd_rf ne {}} {
-		read $fd_rf
-		if {![eof $fd_rf]} return
-		close $fd_rf
-	}
-
-	set ui_status_value "Updating working directory to '$new_branch'..."
-	set cmd [list git read-tree]
-	lappend cmd -m
-	lappend cmd -u
-	lappend cmd --exclude-per-directory=.gitignore
-	lappend cmd $HEAD
-	lappend cmd $new_branch
-	set fd_rt [open "| $cmd" r]
-	fconfigure $fd_rt -blocking 0 -translation binary
-	fileevent $fd_rt readable \
-		[list switch_branch_readtree_wait $fd_rt $new_branch]
-}
-
-proc switch_branch_readtree_wait {fd_rt new_branch} {
-	global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
-	global current_branch
-	global ui_comm ui_status_value
-
-	# -- We never get interesting output on stdout; only stderr.
-	#
-	read $fd_rt
-	fconfigure $fd_rt -blocking 1
-	if {![eof $fd_rt]} {
-		fconfigure $fd_rt -blocking 0
-		return
-	}
-
-	# -- The working directory wasn't in sync with the index and
-	#    we'd have to overwrite something to make the switch. A
-	#    merge is required.
-	#
-	if {[catch {close $fd_rt} err]} {
-		regsub {^fatal: } $err {} err
-		warn_popup "File level merge required.
-
-$err
-
-Staying on branch '$current_branch'."
-		set ui_status_value "Aborted checkout of '$new_branch' (file level merging is required)."
-		unlock_index
-		return
-	}
-
-	# -- Update the symbolic ref.  Core git doesn't even check for failure
-	#    here, it Just Works(tm).  If it doesn't we are in some really ugly
-	#    state that is difficult to recover from within git-gui.
-	#
-	if {[catch {git symbolic-ref HEAD "refs/heads/$new_branch"} err]} {
-		error_popup "Failed to set current branch.
-
-This working directory is only partially switched.  We successfully updated your files, but failed to update an internal Git file.
-
-This should not have occurred.  [appname] will now close and give up.
-
-$err"
-		do_quit
-		return
-	}
-
-	# -- Update our repository state.  If we were previously in amend mode
-	#    we need to toss the current buffer and do a full rescan to update
-	#    our file lists.  If we weren't in amend mode our file lists are
-	#    accurate and we can avoid the rescan.
-	#
-	unlock_index
-	set selected_commit_type new
-	if {[string match amend* $commit_type]} {
-		$ui_comm delete 0.0 end
-		$ui_comm edit reset
-		$ui_comm edit modified false
-		rescan {set ui_status_value "Checked out branch '$current_branch'."}
-	} else {
-		repository_state commit_type HEAD MERGE_HEAD
-		set PARENT $HEAD
-		set ui_status_value "Checked out branch '$current_branch'."
-	}
-}

File git-gui/lib/branch_checkout.tcl

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

File git-gui/lib/branch_create.tcl

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

File git-gui/lib/branch_delete.tcl

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

File git-gui/lib/branch_rename.tcl

 field newname
 
 constructor dialog {} {
-	global all_heads current_branch
+	global current_branch
 
 	make_toplevel top w
 	wm title $top "[appname] ([reponame]): Rename Branch"
 
 	frame $w.rename
 	label $w.rename.oldname_l -text {Branch:}
-	eval tk_optionMenu $w.rename.oldname_m @oldname $all_heads
+	eval tk_optionMenu $w.rename.oldname_m @oldname [load_all_heads]
 
 	label $w.rename.newname_l -text {New Name:}
 	entry $w.rename.newname_t \
 }
 
 method _rename {} {
-	global all_heads current_branch
+	global current_branch
 
 	if {$oldname eq {}} {
 		tk_messageBox \
 		return
 	}
 
-	set oldidx [lsearch -exact -sorted $all_heads $oldname]
-	if {$oldidx >= 0} {
-		set all_heads [lreplace $all_heads $oldidx $oldidx]
-	}
-	lappend all_heads $newname
-	set all_heads [lsort $all_heads]
-	populate_branch_menu
-
 	if {$current_branch eq $oldname} {
 		set current_branch $newname
 	}

File git-gui/lib/browser.tcl

 field browser_stack  {}
 field browser_busy   1
 
+field ls_buf     {}; # Buffered record output from ls-tree
+
 constructor new {commit} {
 	global cursor_ptr M1B
 	make_toplevel top w
 }
 
 method _ls {tree_id {name {}}} {
-	set browser_buffer {}
+	set ls_buf {}
 	set browser_files {}
 	set browser_busy 1
 
 	lappend browser_stack [list $tree_id $name]
 	$w conf -state disabled
 
-	set cmd [list git ls-tree -z $tree_id]
-	set fd [open "| $cmd" r]
+	set fd [git_read ls-tree -z $tree_id]
 	fconfigure $fd -blocking 0 -translation binary -encoding binary
 	fileevent $fd readable [cb _read $fd]
 }
 
 method _read {fd} {
-	append browser_buffer [read $fd]
-	set pck [split $browser_buffer "\0"]
-	set browser_buffer [lindex $pck end]
+	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 info [split $p "\t"]
-		set path [lindex $info 1]
-		set info [split [lindex $info 0] { }]
-		set type [lindex $info 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 {
 		close $fd
 		set browser_status Ready.
 		set browser_busy 0
-		unset browser_buffer
+		set ls_buf {}
 		if {$n > 0} {
 			$w tag add in_sel 1.0 2.0
 			focus -force $w

File git-gui/lib/checkout_op.tcl

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