git-gui: Abstract the revision picker into a mega widget
[git/mjg.git] / lib / branch_create.tcl
blobef63f810f4e938a6ca33d3c2104aa32e77fa9ec8
1 # git-gui branch create support
2 # Copyright (C) 2006, 2007 Shawn Pearce
4 class branch_create {
6 field w ; # widget path
7 field w_rev ; # mega-widget to pick the initial revision
8 field w_name ; # new branch name widget
10 field name {}; # name of the branch the user has chosen
11 field opt_checkout 1; # automatically checkout the new branch?
13 constructor dialog {} {
14 global repo_config
16 make_toplevel top w
17 wm title $top "[appname] ([reponame]): Create Branch"
18 if {$top ne {.}} {
19 wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
22 label $w.header -text {Create New Branch} -font font_uibold
23 pack $w.header -side top -fill x
25 frame $w.buttons
26 button $w.buttons.create -text Create \
27 -default active \
28 -command [cb _create]
29 pack $w.buttons.create -side right
30 button $w.buttons.cancel -text {Cancel} \
31 -command [list destroy $w]
32 pack $w.buttons.cancel -side right -padx 5
33 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
35 labelframe $w.desc -text {Branch Description}
36 label $w.desc.name_r \
37 -anchor w \
38 -text {Name:}
39 set w_name $w.desc.name_t
40 entry $w_name \
41 -borderwidth 1 \
42 -relief sunken \
43 -width 40 \
44 -textvariable @name \
45 -validate key \
46 -validatecommand [cb _validate %d %S]
47 grid $w.desc.name_r $w_name -sticky we -padx {0 5}
49 grid columnconfigure $w.desc 1 -weight 1
50 pack $w.desc -anchor nw -fill x -pady 5 -padx 5
52 set w_rev [::choose_rev::new $w.rev {Starting Revision}]
53 pack $w.rev -anchor nw -fill x -pady 5 -padx 5
55 labelframe $w.postActions -text {Post Creation Actions}
56 checkbutton $w.postActions.checkout \
57 -text {Checkout after creation} \
58 -variable @opt_checkout
59 pack $w.postActions.checkout -anchor nw
60 pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
62 set name $repo_config(gui.newbranchtemplate)
64 bind $w <Visibility> "
65 grab $w
66 $w_name icursor end
67 focus $w_name
69 bind $w <Key-Escape> [list destroy $w]
70 bind $w <Key-Return> [cb _create]\;break
71 tkwait window $w
74 method _create {} {
75 global null_sha1 repo_config
76 global all_heads
78 set newbranch $name
79 if {$newbranch eq {}
80 || $newbranch eq $repo_config(gui.newbranchtemplate)} {
81 tk_messageBox \
82 -icon error \
83 -type ok \
84 -title [wm title $w] \
85 -parent $w \
86 -message "Please supply a branch name."
87 focus $w_name
88 return
90 if {![catch {git show-ref --verify -- "refs/heads/$newbranch"}]} {
91 tk_messageBox \
92 -icon error \
93 -type ok \
94 -title [wm title $w] \
95 -parent $w \
96 -message "Branch '$newbranch' already exists."
97 focus $w_name
98 return
100 if {[catch {git check-ref-format "heads/$newbranch"}]} {
101 tk_messageBox \
102 -icon error \
103 -type ok \
104 -title [wm title $w] \
105 -parent $w \
106 -message "We do not like '$newbranch' as a branch name."
107 focus $w_name
108 return
111 if {[catch {set cmt [$w_rev get_commit]}]} {
112 tk_messageBox \
113 -icon error \
114 -type ok \
115 -title [wm title $w] \
116 -parent $w \
117 -message "Invalid starting revision: [$w_rev get]"
118 return
120 if {[catch {
121 git update-ref \
122 -m "branch: Created from [$w_rev get]" \
123 "refs/heads/$newbranch" \
124 $cmt \
125 $null_sha1
126 } err]} {
127 tk_messageBox \
128 -icon error \
129 -type ok \
130 -title [wm title $w] \
131 -parent $w \
132 -message "Failed to create '$newbranch'.\n\n$err"
133 return
136 lappend all_heads $newbranch
137 set all_heads [lsort $all_heads]
138 populate_branch_menu
139 destroy $w
140 if {$opt_checkout} {
141 switch_branch $newbranch
145 method _validate {d S} {
146 if {$d == 1} {
147 if {[regexp {[~^:?*\[\0- ]} $S]} {
148 return 0
150 if {[string length $S] > 0} {
151 set name_type user
154 return 1