git-gui: Abstract the revision picker into a mega widget

This rather large change pulls the "Starting Revision" part of the
new branch dialog into a mega widget that we can use anytime we
need to select a commit SHA-1.  To make use of the mega widget I
have also refactored the branch dialog to use the class system,
much like the delete remote branch dialog already does.

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

3 files changed, 284 insertions, 210 deletions

diff --git a/lib/branch.tcl b/lib/branch.tcl
index 4f648b2bc..e7559f978 100644
--- a/lib/branch.tcl
+++ b/lib/branch.tcl
@@ -61,221 +61,11 @@ proc populate_branch_menu {} {
 	}
 }
 
-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
-	}
-}
-
 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
diff --git a/lib/branch_create.tcl b/lib/branch_create.tcl
new file mode 100644
index 000000000..ef63f810f
--- /dev/null
+++ b/lib/branch_create.tcl
@@ -0,0 +1,157 @@
+# 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 opt_checkout  1; # automatically checkout the new branch?
+
+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 Description}
+	label $w.desc.name_r \
+		-anchor w \
+		-text {Name:}
+	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}
+
+	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 x -pady 5 -padx 5
+
+	labelframe $w.postActions -text {Post Creation Actions}
+	checkbutton $w.postActions.checkout \
+		-text {Checkout after creation} \
+		-variable @opt_checkout
+	pack $w.postActions.checkout -anchor nw
+	pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
+
+	set name $repo_config(gui.newbranchtemplate)
+
+	bind $w <Visibility> "
+		grab $w
+		$w_name icursor end
+		focus $w_name
+	"
+	bind $w <Key-Escape> [list destroy $w]
+	bind $w <Key-Return> [cb _create]\;break
+	tkwait window $w
+}
+
+method _create {} {
+	global null_sha1 repo_config
+	global all_heads
+
+	set newbranch $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_name
+		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_name
+		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_name
+		return
+	}
+
+	if {[catch {set cmt [$w_rev get_commit]}]} {
+		tk_messageBox \
+			-icon error \
+			-type ok \
+			-title [wm title $w] \
+			-parent $w \
+			-message "Invalid starting revision: [$w_rev get]"
+		return
+	}
+	if {[catch {
+			git update-ref \
+				-m "branch: Created from [$w_rev get]" \
+				"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 {$opt_checkout} {
+		switch_branch $newbranch
+	}
+}
+
+method _validate {d S} {
+	if {$d == 1} {
+		if {[regexp {[~^:?*\[\0- ]} $S]} {
+			return 0
+		}
+		if {[string length $S] > 0} {
+			set name_type user
+		}
+	}
+	return 1
+}
+
+}
diff --git a/lib/choose_rev.tcl b/lib/choose_rev.tcl
new file mode 100644
index 000000000..04f77c009
--- /dev/null
+++ b/lib/choose_rev.tcl
@@ -0,0 +1,127 @@
+# git-gui revision chooser
+# Copyright (C) 2006, 2007 Shawn Pearce
+
+class choose_rev {
+
+field w               ; # our megawidget path
+field revtype       {}; # type of revision chosen
+
+field c_head        {}; # selected local branch head
+field c_trck        {}; # selected tracking branch
+field c_tag         {}; # selected tag
+field c_expr        {}; # current revision expression
+
+constructor new {path {title {}}} {
+	global all_heads current_branch
+
+	set w $path
+
+	if {$title ne {}} {
+		labelframe $w -text $title
+	} else {
+		frame $w
+	}
+	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 all_trackings [all_tracking_branches]
+	if {$all_trackings ne {}} {
+		set c_trck [lindex $all_trackings 0]
+		radiobutton $w.trck_r \
+			-text {Tracking Branch:} \
+			-value trck \
+			-variable @revtype
+		eval tk_optionMenu $w.trck_m @c_trck $all_trackings
+		grid $w.trck_r $w.trck_m -sticky w
+		if {$revtype eq {}} {
+			set revtype trck
+		}
+		trace add variable @c_trck write [cb _select trck]
+	}
+
+	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 \
+		-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}
+	if {$revtype eq {}} {
+		set revtype expr
+	}
+
+	grid columnconfigure $w 1 -weight 1
+	return $this
+}
+
+method get {} {
+	switch -- $revtype {
+	head { return $c_head }
+	trck { return $c_trck }
+	tag  { return $c_tag  }
+	expr { return $c_expr }
+	default { error "unknown type of revision" }
+	}
+}
+
+method get_commit {} {
+	set rev [get $this]
+	return [git rev-parse --verify "${rev}^0"]
+}
+
+method _validate {d S} {
+	if {$d == 1} {
+		if {[regexp {\s} $S]} {
+			return 0
+		}
+		if {[string length $S] > 0} {
+			set revtype expr
+		}
+	}
+	return 1
+}
+
+method _select {value args} {
+	set revtype $value
+}
+
+method _delete {current} {
+	if {$current eq $w} {
+		delete_this
+	}
+}
+
+}