1 # git-gui branch create support
2 # Copyright (C) 2006, 2007 Shawn Pearce
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
{} {
17 wm title
$top "[appname] ([reponame]): Create Branch"
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
26 button $w.buttons.create
-text 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
\
39 set w_name
$w.desc.name_t
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
> "
69 bind $w <Key-Escape
> [list destroy $w]
70 bind $w <Key-Return
> [cb _create
]\;break
75 global null_sha1 repo_config
80 ||
$newbranch eq
$repo_config(gui.newbranchtemplate
)} {
84 -title [wm title
$w] \
86 -message "Please supply a branch name."
90 if {![catch {git show-ref
--verify -- "refs/heads/$newbranch"}]} {
94 -title [wm title
$w] \
96 -message "Branch '$newbranch' already exists."
100 if {[catch {git check-ref-format
"heads/$newbranch"}]} {
104 -title [wm title
$w] \
106 -message "We do not like '$newbranch' as a branch name."
111 if {[catch {set cmt
[$w_rev get_commit
]}]} {
115 -title [wm title
$w] \
117 -message "Invalid starting revision: [$w_rev get]"
122 -m "branch: Created from [$w_rev get]" \
123 "refs/heads/$newbranch" \
130 -title [wm title
$w] \
132 -message "Failed to create '$newbranch'.\n\n$err"
136 lappend all_heads
$newbranch
137 set all_heads
[lsort $all_heads]
141 switch_branch
$newbranch
145 method _validate
{d S
} {
147 if {[regexp {[~^
:?
*\[\0- ]} $S]} {
150 if {[string length
$S] > 0} {