git-gui: Enhance choose_rev to handle hundreds of branches

One of my production repositories has hundreds of remote tracking
branches.  Trying to navigate these through a popup menu is just
not possible.  The list is far larger than the screen and it does
not scroll fast enough to efficiently select a branch name when
trying to create a branch or delete a branch.

This is major rewrite of the revision chooser mega-widget.  We
now use a single listbox for all three major types of named refs
(heads, tracking branches, tags) and a radio button group to pick
which of those namespaces should be shown in the listbox.  A filter
field is shown to the right allowing the end-user to key in a glob
specification to filter the list they are viewing.  The filter is
always taken as substring, so we assume * both starts and ends the
pattern the user wanted but otherwise treat it as a glob pattern.

This new picker works out really nicely.  What used to take me at
least a minute to find and select a branch now takes mere seconds.

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

lib/branch_create.tcl

@@ -63,7 +63,7 @@ constructor dialog {} {
 	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 x -pady 5 -padx 5
+	pack $w.rev -anchor nw -fill both -expand 1 -pady 5 -padx 5
 
 	labelframe $w.options -text {Options}
 
@@ -170,13 +170,7 @@ method _create {} {
 		return
 	}
 
-	if {[catch {set new [$w_rev get_commit]}]} {
-		tk_messageBox \
-			-icon error \
-			-type ok \
-			-title [wm title $w] \
-			-parent $w \
-			-message "Invalid revision: [$w_rev get]"
+	if {[catch {set new [$w_rev commit_or_die]}]} {
 		return
 	}
 

lib/branch_delete.tcl

@@ -40,6 +40,7 @@ constructor dialog {} {
 		-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
@@ -80,13 +81,7 @@ method _select {} {
 method _delete {} {
 	global all_heads
 
-	if {[catch {set check_cmt [$w_check get_commit]} err]} {
-		tk_messageBox \
-			-icon error \
-			-type ok \
-			-title [wm title $w] \
-			-parent $w \
-			-message "Invalid revision: [$w_check get]"
+	if {[catch {set check_cmt [$w_check commit_or_die]}]} {
 		return
 	}
 

lib/choose_rev.tcl

@@ -3,15 +3,19 @@
 
 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 revtype       {}; # type of revision chosen
+field w_list          ; # list of currently filtered specs
+field w_filter        ; # filter entry for $w_list
 
-field c_head        {}; # selected local branch head
-field c_trck        {}; # selected tracking branch
-field c_tag         {}; # selected tag
 field c_expr        {}; # current revision expression
-
-field trck_spec       ; # array of specifications
+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
 
 constructor new {path {title {}}} {
 	global all_heads current_branch
@@ -25,61 +29,6 @@ constructor new {path {title {}}} {
 	}
 	bind $w <Destroy> [cb _delete %W]
 
-	if {$all_heads ne {}} {
-		set c_head $current_branch
-		radiobutton $w.head_r \
-			-text {Local Branch:} \
-			-value head \
-			-variable @revtype
-		eval tk_optionMenu $w.head_m @c_head $all_heads
-		grid $w.head_r $w.head_m -sticky w
-		if {$revtype eq {}} {
-			set revtype head
-		}
-		trace add variable @c_head write [cb _select head]
-	}
-
-	set trck_list [all_tracking_branches]
-	if {$trck_list ne {}} {
-		set nam [list]
-		foreach spec $trck_list {
-			set txt [lindex $spec 0]
-			regsub ^refs/(heads/|remotes/)? $txt {} txt
-			set trck_spec($txt) $spec
-			lappend nam $txt
-		}
-		set nam [lsort -unique $nam]
-
-		radiobutton $w.trck_r \
-			-text {Tracking Branch:} \
-			-value trck \
-			-variable @revtype
-		eval tk_optionMenu $w.trck_m @c_trck $nam
-		grid $w.trck_r $w.trck_m -sticky w
-
-		set c_trck [lindex $nam 0]
-		if {$revtype eq {}} {
-			set revtype trck
-		}
-		trace add variable @c_trck write [cb _select trck]
-		unset nam spec txt
-	}
-
-	set all_tags [load_all_tags]
-	if {$all_tags ne {}} {
-		set c_tag [lindex $all_tags 0]
-		radiobutton $w.tag_r \
-			-text {Tag:} \
-			-value tag \
-			-variable @revtype
-		eval tk_optionMenu $w.tag_m @c_tag $all_tags
-		grid $w.tag_r $w.tag_m -sticky w
-		if {$revtype eq {}} {
-			set revtype tag
-		}
-		trace add variable @c_tag write [cb _select tag]
-	}
-
 	radiobutton $w.expr_r \
 		-text {Revision Expression:} \
 		-value expr \
@@ -92,66 +41,186 @@ constructor new {path {title {}}} {
 		-validate key \
 		-validatecommand [cb _validate %d %S]
 	grid $w.expr_r $w.expr_t -sticky we -padx {0 5}
-	if {$revtype eq {}} {
-		set revtype expr
-	}
+
+	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 5 \
+		-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
 
 	grid columnconfigure $w 1 -weight 1
+	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 spec_head [list]
+	foreach name $all_heads {
+		lappend spec_head [list $name refs/heads/$name]
+	}
+
+	set spec_trck [list]
+	foreach spec [all_tracking_branches] {
+		set name [lindex $spec 0]
+		regsub ^refs/(heads|remotes)/ $name {} name
+		lappend spec_trck [concat $name $spec]
+	}
+
+	set spec_tag [list]
+	foreach name [load_all_tags] {
+		lappend spec_tag [list $name refs/tags/$name]
+	}
+
+	      if {[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 set $i
+				break
+			}
+			incr i
+		}
+	}
+
 	return $this
 }
 
 method none {text} {
-	if {[winfo exists $w.none_r]} {
-		$w.none_r configure -text $text
-		return
-	}
-
-	radiobutton $w.none_r \
-		-anchor w \
-		-text $text \
-		-value none \
-		-variable @revtype
-	grid $w.none_r -sticky we -padx {0 5} -columnspan 2
-	if {$revtype eq {}} {
-		set revtype none
+	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 { return $c_head }
-	trck { return $c_trck }
-	tag  { return $c_tag  }
-	expr { return $c_expr }
-	none { return {}      }
+	head -
+	trck -
+	tag  {
+		set i [$w_list curselection]
+		if {$i ne {}} {
+			return [lindex $cur_specs $i 0]
+		} else {
+			return {}
+		}
+	}
+
+	expr { return $c_expr                  }
+	none { return {}                       }
 	default { error "unknown type of revision" }
 	}
 }
 
 method get_tracking_branch {} {
-	if {$revtype eq {trck}} {
-		return $trck_spec($c_trck)
-	} else {
+	set i [$w_list curselection]
+	if {$i eq {} || $revtype ne {trck}} {
 		return {}
 	}
-}
-
-method get_expr {} {
-	switch -- $revtype {
-	head { return refs/heads/$c_head             }
-	trck { return [lindex $trck_spec($c_trck) 0] }
-	tag  { return refs/tags/$c_tag               }
-	expr { return $c_expr                        }
-	none { return {}                             }
-	default { error "unknown type of revision"   }
-	}
+	return [lrange [lindex $cur_specs $i] 1 end]
 }
 
 method get_commit {} {
-	if {$revtype eq {none}} {
+	set e [_expr $this]
+	if {$e eq {}} {
 		return {}
 	}
-	return [git rev-parse --verify "[get_expr $this]^0"]
+	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."
+		}
+	}
+	none { return {}                       }
+	default { error "unknown type of revision"      }
+	}
 }
 
 method _validate {d S} {
@@ -166,8 +235,55 @@ method _validate {d S} {
 	return 1
 }
 
-method _select {value args} {
-	set revtype $value
+method _filter {P} {
+	if {[regexp {\s} $P]} {
+		return 0
+	}
+	_rebuild $this $P
+	return 1
+}
+
+method _select {args} {
+	_rebuild $this $filter
+	if {[$w_filter cget -state] eq {normal}} {
+		focus $w_filter
+	}
+}
+
+method _rebuild {pat} {
+	set ste normal
+	switch -- $revtype {
+	head { set new $spec_head }
+	trck { set new $spec_trck }
+	tag  { set new $spec_tag  }
+	expr -
+	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 {[$w_filter cget -state] ne $ste} {
+		$w_list   configure -state $ste
+		$w_filter configure -state $ste
+	}
 }
 
 method _delete {current} {
@@ -176,4 +292,34 @@ method _delete {current} {
 	}
 }
 
+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
+}
+
 }