From: Junio C Hamano <gitster@pobox.com>
Date: Mon, 11 Jun 2007 07:52:43 +0000 (-0700)
Subject: Merge branch 'master' of git://repo.or.cz/git-gui
X-Git-Tag: v1.5.3-rc0~118
X-Git-Url: https://asedeno.scripts.mit.edu/gitweb/?a=commitdiff_plain;h=75d8ff138dd640a117c6aaa625d0f6b835adbd3a;hp=27c1dbea3e3a23b3c4b3707dfc9a71c3279ae279;p=git.git

Merge branch 'master' of git://repo.or.cz/git-gui

* 'master' of git://repo.or.cz/git-gui:
  git-gui: Internalize symbolic-ref HEAD reading logic
  git-gui: Expose the merge.diffstat configuration option
  git-gui: Allow users to delete remote branches
  git-gui: Allow users to rename branches through 'branch -m'
  git-gui: Disable tearoff menus on Windows, Mac OS X
  git-gui: Provide fatal error if library is unavailable
  git-gui: Enable verbose Tcl loading earlier
  git-gui: Show the git-gui library path in 'About git-gui'
  git-gui: GUI support for running 'git remote prune <name>'
  git gui 0.8.0
---

diff --git a/git-gui/GIT-VERSION-GEN b/git-gui/GIT-VERSION-GEN
index eee495a98..9770b0bc2 100755
--- a/git-gui/GIT-VERSION-GEN
+++ b/git-gui/GIT-VERSION-GEN
@@ -1,7 +1,7 @@
 #!/bin/sh
 
 GVF=GIT-VERSION-FILE
-DEF_VER=0.7.GITGUI
+DEF_VER=0.8.GITGUI
 
 LF='
 '
diff --git a/git-gui/git-gui.sh b/git-gui/git-gui.sh
index dfb4b955e..e33ee03bc 100755
--- a/git-gui/git-gui.sh
+++ b/git-gui/git-gui.sh
@@ -36,6 +36,24 @@ if {[catch {package require Tcl 8.4} err]
 	exit 1
 }
 
+######################################################################
+##
+## enable verbose loading?
+
+if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
+	unset _verbose
+	rename auto_load real__auto_load
+	proc auto_load {name args} {
+		puts stderr "auto_load $name"
+		return [uplevel 1 real__auto_load $name $args]
+	}
+	rename source real__source
+	proc source {name} {
+		puts stderr "source    $name"
+		uplevel 1 real__source $name
+	}
+}
+
 ######################################################################
 ##
 ## configure our library
@@ -48,26 +66,33 @@ if {$oguirel eq {1}} {
 } elseif {[string match @@* $oguirel]} {
 	set oguilib [file join [file dirname [file normalize $argv0]] lib]
 }
+
 set idx [file join $oguilib tclIndex]
-catch {
-	set fd [open $idx r]
-	if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
-		set idx [list]
-		while {[gets $fd n] >= 0} {
-			if {$n ne {} && ![string match #* $n]} {
-				lappend idx $n
-			}
+if {[catch {set fd [open $idx r]} err]} {
+	catch {wm withdraw .}
+	tk_messageBox \
+		-icon error \
+		-type ok \
+		-title "git-gui: fatal error" \
+		-message $err
+	exit 1
+}
+if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
+	set idx [list]
+	while {[gets $fd n] >= 0} {
+		if {$n ne {} && ![string match #* $n]} {
+			lappend idx $n
 		}
-	} else {
-		set idx {}
 	}
-	close $fd
+} else {
+	set idx {}
 }
+close $fd
+
 if {$idx ne {}} {
 	set loaded [list]
 	foreach p $idx {
 		if {[lsearch -exact $loaded $p] >= 0} continue
-		puts $p
 		source [file join $oguilib $p]
 		lappend loaded $p
 	}
@@ -75,21 +100,7 @@ if {$idx ne {}} {
 } else {
 	set auto_path [concat [list $oguilib] $auto_path]
 }
-unset -nocomplain oguilib oguirel idx fd
-
-if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
-	unset _verbose
-	rename auto_load real__auto_load
-	proc auto_load {name args} {
-		puts stderr "auto_load $name"
-		return [uplevel 1 real__auto_load $name $args]
-	}
-	rename source real__source
-	proc source {name} {
-		puts stderr "source    $name"
-		uplevel 1 real__source $name
-	}
-}
+unset -nocomplain oguirel idx fd
 
 ######################################################################
 ##
@@ -205,6 +216,15 @@ proc is_config_true {name} {
 	}
 }
 
+proc get_config {name} {
+	global repo_config
+	if {[catch {set v $repo_config($name)}]} {
+		return {}
+	} else {
+		return $v
+	}
+}
+
 proc load_config {include_global} {
 	global repo_config global_config default_config
 
@@ -258,6 +278,17 @@ proc git {args} {
 	return [eval exec git $args]
 }
 
+proc current-branch {} {
+	set ref {}
+	set fd [open [gitdir HEAD] r]
+	if {[gets $fd ref] <16
+	 || ![regsub {^ref: refs/heads/} $ref {} ref]} {
+		set ref {}
+	}
+	close $fd
+	return $ref
+}
+
 auto_load tk_optionMenu
 rename tk_optionMenu real__tkOptionMenu
 proc tk_optionMenu {w varName args} {
@@ -406,15 +437,7 @@ proc repository_state {ctvar hdvar mhvar} {
 
 	set mh [list]
 
-	if {[catch {set current_branch [git symbolic-ref HEAD]}]} {
-		set current_branch {}
-	} else {
-		regsub ^refs/((heads|tags|remotes)/)? \
-			$current_branch \
-			{} \
-			current_branch
-	}
-
+	set current_branch [current-branch]
 	if {[catch {set hd [git rev-parse --verify HEAD]}]} {
 		set hd {}
 		set ct initial
@@ -1229,6 +1252,10 @@ foreach class {Button Checkbutton Entry Label
 }
 unset class
 
+if {[is_Windows] || [is_MacOSX]} {
+	option add *Menu.tearOff 0
+}
+
 if {[is_MacOSX]} {
 	set M1B M1
 	set M1T Cmd
@@ -1259,11 +1286,13 @@ proc apply_config {} {
 	}
 }
 
+set default_config(merge.diffstat) true
 set default_config(merge.summary) false
 set default_config(merge.verbosity) 2
 set default_config(user.name) {}
 set default_config(user.email) {}
 
+set default_config(gui.pruneduringfetch) false
 set default_config(gui.trustmtime) false
 set default_config(gui.diffcontext) 5
 set default_config(gui.newbranchtemplate) {}
@@ -1425,6 +1454,11 @@ if {[is_enabled branch]} {
 	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
 	lappend disable_on_lock [list .mbar.branch entryconf \
@@ -1522,6 +1556,8 @@ if {[is_enabled transport]} {
 	menu .mbar.push
 	.mbar.push add command -label {Push...} \
 		-command do_push_anywhere
+	.mbar.push add command -label {Delete...} \
+		-command remote_branch_delete::dialog
 }
 
 if {[is_MacOSX]} {
@@ -1639,14 +1675,8 @@ switch -- $subcommand {
 browser {
 	set subcommand_args {rev?}
 	switch [llength $argv] {
-	0 {
-		set current_branch [git symbolic-ref HEAD]
-		regsub ^refs/((heads|tags|remotes)/)? \
-			$current_branch {} current_branch
-	}
-	1 {
-		set current_branch [lindex $argv 0]
-	}
+	0 { set current_branch [current-branch] }
+	1 { set current_branch [lindex $argv 0] }
 	default usage
 	}
 	browser::new $current_branch
@@ -1679,9 +1709,7 @@ blame {
 	unset is_path
 
 	if {$head eq {}} {
-		set current_branch [git symbolic-ref HEAD]
-		regsub ^refs/((heads|tags|remotes)/)? \
-			$current_branch {} current_branch
+		set current_branch [current-branch]
 	} else {
 		set current_branch $head
 	}
diff --git a/git-gui/lib/branch_rename.tcl b/git-gui/lib/branch_rename.tcl
new file mode 100644
index 000000000..54c72b980
--- /dev/null
+++ b/git-gui/lib/branch_rename.tcl
@@ -0,0 +1,137 @@
+# git-gui branch rename support
+# Copyright (C) 2007 Shawn Pearce
+
+class branch_rename {
+
+field w
+field oldname
+field newname
+
+constructor dialog {} {
+	global all_heads 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 $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
+	"
+	bind $w.header <Destroy> [list delete_this $this]
+	tkwait window $w
+}
+
+method _rename {} {
+	global all_heads 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
+	}
+
+	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
+	}
+
+	destroy $w
+}
+
+}
diff --git a/git-gui/lib/option.tcl b/git-gui/lib/option.tcl
index b29e14e64..ae19a8f9c 100644
--- a/git-gui/lib/option.tcl
+++ b/git-gui/lib/option.tcl
@@ -55,7 +55,7 @@ proc save_config {} {
 }
 
 proc do_about {} {
-	global appvers copyright
+	global appvers copyright oguilib
 	global tcl_patchLevel tk_patchLevel
 
 	set w .about_dialog
@@ -94,6 +94,10 @@ $copyright" \
 		append v ", Tk version $tk_patchLevel"
 	}
 
+	set d {}
+	append d "git exec dir: [gitexec]\n"
+	append d "git-gui lib: $oguilib"
+
 	label $w.vers \
 		-text $v \
 		-padx 5 -pady 5 \
@@ -103,6 +107,15 @@ $copyright" \
 		-relief solid
 	pack $w.vers -side top -fill x -padx 5 -pady 5
 
+	label $w.dirs \
+		-text $d \
+		-padx 5 -pady 5 \
+		-justify left \
+		-anchor w \
+		-borderwidth 1 \
+		-relief solid
+	pack $w.dirs -side top -fill x -padx 5 -pady 5
+
 	menu $w.ctxm -tearoff 0
 	$w.ctxm add command \
 		-label {Copy} \
@@ -174,8 +187,10 @@ proc do_options {} {
 
 		{b merge.summary {Summarize Merge Commits}}
 		{i-1..5 merge.verbosity {Merge Verbosity}}
+		{b merge.diffstat {Show Diffstat After Merge}}
 
 		{b gui.trustmtime  {Trust File Modification Timestamps}}
+		{b gui.pruneduringfetch {Prune Tracking Branches During Fetch}}
 		{i-0..99 gui.diffcontext {Number of Diff Context Lines}}
 		{t gui.newbranchtemplate {New Branch Name Template}}
 		} {
diff --git a/git-gui/lib/remote.tcl b/git-gui/lib/remote.tcl
index 99f353ed7..b54824ab7 100644
--- a/git-gui/lib/remote.tcl
+++ b/git-gui/lib/remote.tcl
@@ -95,6 +95,7 @@ proc populate_fetch_menu {} {
 	global all_remotes repo_config
 
 	set m .mbar.fetch
+	set prune_list [list]
 	foreach r $all_remotes {
 		set enable 0
 		if {![catch {set a $repo_config(remote.$r.url)}]} {
@@ -115,11 +116,21 @@ proc populate_fetch_menu {} {
 		}
 
 		if {$enable} {
+			lappend prune_list $r
 			$m add command \
 				-label "Fetch from $r..." \
 				-command [list fetch_from $r]
 		}
 	}
+
+	if {$prune_list ne {}} {
+		$m add separator
+	}
+	foreach r $prune_list {
+		$m add command \
+			-label "Prune from $r..." \
+			-command [list prune_from $r]
+	}
 }
 
 proc populate_push_menu {} {
diff --git a/git-gui/lib/remote_branch_delete.tcl b/git-gui/lib/remote_branch_delete.tcl
new file mode 100644
index 000000000..bc39581b8
--- /dev/null
+++ b/git-gui/lib/remote_branch_delete.tcl
@@ -0,0 +1,348 @@
+# 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 -expand 1
+	pack $w.heads.footer.rescan -side right
+
+	pack $w.heads.footer -side bottom -fill x -expand 1
+	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]
+	bind $w.header <Destroy> [list delete_this $this]
+	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 [open "| [list git ls-remote $uri]" r]
+		fconfigure $active_ls \
+			-blocking 0 \
+			-translation lf \
+			-encoding utf-8
+		fileevent $active_ls readable [cb _read $cache $active_ls]
+	} else {
+		set status {}
+		set full_list $full_cache($cache)
+		set head_list $head_cache($cache)
+		$w.heads.l conf -state normal
+	}
+}
+
+method _read {cache fd} {
+	if {$fd ne $active_ls} {
+		catch {close $fd}
+		return
+	}
+
+	while {[gets $fd line] >= 0} {
+		if {[string match {*^{}} $line]} continue
+		if {[regexp {^([0-9a-f]{40})	(.*)$} $line _junk obj ref]} {
+			if {[regsub ^refs/heads/ $ref {} abr]} {
+				lappend head_list $abr
+				lappend head_cache($cache) $abr
+				lappend full_list $ref
+				lappend full_cache($cache) $ref
+				set full_cache("$cache\n$ref") $obj
+			}
+		}
+	}
+
+	if {[eof $fd]} {
+		if {[catch {close $fd} err]} {
+			set status $err
+			set head_list [list]
+			set full_list [list]
+		} else {
+			set status {}
+			set cached($cache) 1
+			$w.heads.l conf -state normal
+		}
+	}
+} ifdeleted {
+	catch {close $fd}
+}
+
+}
diff --git a/git-gui/lib/transport.tcl b/git-gui/lib/transport.tcl
index c0e7d20fc..e8ebc6eda 100644
--- a/git-gui/lib/transport.tcl
+++ b/git-gui/lib/transport.tcl
@@ -5,9 +5,19 @@ proc fetch_from {remote} {
 	set w [console::new \
 		"fetch $remote" \
 		"Fetching new changes from $remote"]
-	set cmd [list git fetch]
-	lappend cmd $remote
-	console::exec $w $cmd
+	set cmds [list]
+	lappend cmds [list exec git fetch $remote]
+	if {[is_config_true gui.pruneduringfetch]} {
+		lappend cmds [list exec git remote prune $remote]
+	}
+	console::chain $w $cmds
+}
+
+proc prune_from {remote} {
+	set w [console::new \
+		"remote prune $remote" \
+		"Pruning tracking branches deleted from $remote"]
+	console::exec $w [list git remote prune $remote]
 }
 
 proc push_to {remote} {