git-gui: Allow users to match remote branch names locally
[git/gitweb.git] / lib / branch_create.tcl
blob7f82424edace4b473977d5fe9d37ee268cb3148f
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 name_type user; # type of branch name to use
13 field opt_checkout 1; # automatically checkout the new branch?
15 constructor dialog {} {
16 global repo_config
18 make_toplevel top w
19 wm title $top "[appname] ([reponame]): Create Branch"
20 if {$top ne {.}} {
21 wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
24 label $w.header -text {Create New Branch} -font font_uibold
25 pack $w.header -side top -fill x
27 frame $w.buttons
28 button $w.buttons.create -text Create \
29 -default active \
30 -command [cb _create]
31 pack $w.buttons.create -side right
32 button $w.buttons.cancel -text {Cancel} \
33 -command [list destroy $w]
34 pack $w.buttons.cancel -side right -padx 5
35 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
37 labelframe $w.desc -text {Branch Name}
38 radiobutton $w.desc.name_r \
39 -anchor w \
40 -text {Name:} \
41 -value user \
42 -variable @name_type
43 set w_name $w.desc.name_t
44 entry $w_name \
45 -borderwidth 1 \
46 -relief sunken \
47 -width 40 \
48 -textvariable @name \
49 -validate key \
50 -validatecommand [cb _validate %d %S]
51 grid $w.desc.name_r $w_name -sticky we -padx {0 5}
53 radiobutton $w.desc.match_r \
54 -anchor w \
55 -text {Match Tracking Branch Name} \
56 -value match \
57 -variable @name_type
58 grid $w.desc.match_r -sticky we -padx {0 5} -columnspan 2
60 grid columnconfigure $w.desc 1 -weight 1
61 pack $w.desc -anchor nw -fill x -pady 5 -padx 5
63 set w_rev [::choose_rev::new $w.rev {Starting Revision}]
64 pack $w.rev -anchor nw -fill x -pady 5 -padx 5
66 labelframe $w.postActions -text {Post Creation Actions}
67 checkbutton $w.postActions.checkout \
68 -text {Checkout after creation} \
69 -variable @opt_checkout
70 pack $w.postActions.checkout -anchor nw
71 pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
73 set name $repo_config(gui.newbranchtemplate)
75 bind $w <Visibility> "
76 grab $w
77 $w_name icursor end
78 focus $w_name
80 bind $w <Key-Escape> [list destroy $w]
81 bind $w <Key-Return> [cb _create]\;break
82 tkwait window $w
85 method _create {} {
86 global null_sha1 repo_config
87 global all_heads
89 switch -- $name_type {
90 user {
91 set newbranch $name
93 match {
94 set spec [$w_rev get_tracking_branch]
95 if {$spec eq {}} {
96 tk_messageBox \
97 -icon error \
98 -type ok \
99 -title [wm title $w] \
100 -parent $w \
101 -message "Please select a tracking branch."
102 return
104 if {![regsub ^refs/heads/ [lindex $spec 2] {} newbranch]} {
105 tk_messageBox \
106 -icon error \
107 -type ok \
108 -title [wm title $w] \
109 -parent $w \
110 -message "Tracking branch [$w get] is not a branch in the remote repository."
111 return
116 if {$newbranch eq {}
117 || $newbranch eq $repo_config(gui.newbranchtemplate)} {
118 tk_messageBox \
119 -icon error \
120 -type ok \
121 -title [wm title $w] \
122 -parent $w \
123 -message "Please supply a branch name."
124 focus $w_name
125 return
127 if {![catch {git show-ref --verify -- "refs/heads/$newbranch"}]} {
128 tk_messageBox \
129 -icon error \
130 -type ok \
131 -title [wm title $w] \
132 -parent $w \
133 -message "Branch '$newbranch' already exists."
134 focus $w_name
135 return
137 if {[catch {git check-ref-format "heads/$newbranch"}]} {
138 tk_messageBox \
139 -icon error \
140 -type ok \
141 -title [wm title $w] \
142 -parent $w \
143 -message "We do not like '$newbranch' as a branch name."
144 focus $w_name
145 return
148 if {[catch {set cmt [$w_rev get_commit]}]} {
149 tk_messageBox \
150 -icon error \
151 -type ok \
152 -title [wm title $w] \
153 -parent $w \
154 -message "Invalid starting revision: [$w_rev get]"
155 return
157 if {[catch {
158 git update-ref \
159 -m "branch: Created from [$w_rev get]" \
160 "refs/heads/$newbranch" \
161 $cmt \
162 $null_sha1
163 } err]} {
164 tk_messageBox \
165 -icon error \
166 -type ok \
167 -title [wm title $w] \
168 -parent $w \
169 -message "Failed to create '$newbranch'.\n\n$err"
170 return
173 lappend all_heads $newbranch
174 set all_heads [lsort $all_heads]
175 populate_branch_menu
176 destroy $w
177 if {$opt_checkout} {
178 switch_branch $newbranch
182 method _validate {d S} {
183 if {$d == 1} {
184 if {[regexp {[~^:?*\[\0- ]} $S]} {
185 return 0
187 if {[string length $S] > 0} {
188 set name_type user
191 return 1