git-gui: Refactor branch switch to support detached head
[git] / lib / transport.tcl
1 # git-gui transport (fetch/push) support
2 # Copyright (C) 2006, 2007 Shawn Pearce
3
4 proc fetch_from {remote} {
5         set w [console::new \
6                 "fetch $remote" \
7                 "Fetching new changes from $remote"]
8         set cmds [list]
9         lappend cmds [list exec git fetch $remote]
10         if {[is_config_true gui.pruneduringfetch]} {
11                 lappend cmds [list exec git remote prune $remote]
12         }
13         console::chain $w $cmds
14 }
15
16 proc prune_from {remote} {
17         set w [console::new \
18                 "remote prune $remote" \
19                 "Pruning tracking branches deleted from $remote"]
20         console::exec $w [list git remote prune $remote]
21 }
22
23 proc push_to {remote} {
24         set w [console::new \
25                 "push $remote" \
26                 "Pushing changes to $remote"]
27         set cmd [list git push]
28         lappend cmd -v
29         lappend cmd $remote
30         console::exec $w $cmd
31 }
32
33 proc start_push_anywhere_action {w} {
34         global push_urltype push_remote push_url push_thin push_tags
35
36         set r_url {}
37         switch -- $push_urltype {
38         remote {set r_url $push_remote}
39         url {set r_url $push_url}
40         }
41         if {$r_url eq {}} return
42
43         set cmd [list git push]
44         lappend cmd -v
45         if {$push_thin} {
46                 lappend cmd --thin
47         }
48         if {$push_tags} {
49                 lappend cmd --tags
50         }
51         lappend cmd $r_url
52         set cnt 0
53         foreach i [$w.source.l curselection] {
54                 set b [$w.source.l get $i]
55                 lappend cmd "refs/heads/$b:refs/heads/$b"
56                 incr cnt
57         }
58         if {$cnt == 0} {
59                 return
60         } elseif {$cnt == 1} {
61                 set unit branch
62         } else {
63                 set unit branches
64         }
65
66         set cons [console::new \
67                 "push $r_url" \
68                 "Pushing $cnt $unit to $r_url"]
69         console::exec $cons $cmd
70         destroy $w
71 }
72
73 trace add variable push_remote write \
74         [list radio_selector push_urltype remote]
75
76 proc do_push_anywhere {} {
77         global all_remotes current_branch
78         global push_urltype push_remote push_url push_thin push_tags
79
80         set w .push_setup
81         toplevel $w
82         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
83
84         label $w.header -text {Push Branches} -font font_uibold
85         pack $w.header -side top -fill x
86
87         frame $w.buttons
88         button $w.buttons.create -text Push \
89                 -default active \
90                 -command [list start_push_anywhere_action $w]
91         pack $w.buttons.create -side right
92         button $w.buttons.cancel -text {Cancel} \
93                 -default normal \
94                 -command [list destroy $w]
95         pack $w.buttons.cancel -side right -padx 5
96         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
97
98         labelframe $w.source -text {Source Branches}
99         listbox $w.source.l \
100                 -height 10 \
101                 -width 70 \
102                 -selectmode extended \
103                 -yscrollcommand [list $w.source.sby set]
104         foreach h [load_all_heads] {
105                 $w.source.l insert end $h
106                 if {$h eq $current_branch} {
107                         $w.source.l select set end
108                 }
109         }
110         scrollbar $w.source.sby -command [list $w.source.l yview]
111         pack $w.source.sby -side right -fill y
112         pack $w.source.l -side left -fill both -expand 1
113         pack $w.source -fill both -expand 1 -pady 5 -padx 5
114
115         labelframe $w.dest -text {Destination Repository}
116         if {$all_remotes ne {}} {
117                 radiobutton $w.dest.remote_r \
118                         -text {Remote:} \
119                         -value remote \
120                         -variable push_urltype
121                 eval tk_optionMenu $w.dest.remote_m push_remote $all_remotes
122                 grid $w.dest.remote_r $w.dest.remote_m -sticky w
123                 if {[lsearch -sorted -exact $all_remotes origin] != -1} {
124                         set push_remote origin
125                 } else {
126                         set push_remote [lindex $all_remotes 0]
127                 }
128                 set push_urltype remote
129         } else {
130                 set push_urltype url
131         }
132         radiobutton $w.dest.url_r \
133                 -text {Arbitrary URL:} \
134                 -value url \
135                 -variable push_urltype
136         entry $w.dest.url_t \
137                 -borderwidth 1 \
138                 -relief sunken \
139                 -width 50 \
140                 -textvariable push_url \
141                 -validate key \
142                 -validatecommand {
143                         if {%d == 1 && [regexp {\s} %S]} {return 0}
144                         if {%d == 1 && [string length %S] > 0} {
145                                 set push_urltype url
146                         }
147                         return 1
148                 }
149         grid $w.dest.url_r $w.dest.url_t -sticky we -padx {0 5}
150         grid columnconfigure $w.dest 1 -weight 1
151         pack $w.dest -anchor nw -fill x -pady 5 -padx 5
152
153         labelframe $w.options -text {Transfer Options}
154         checkbutton $w.options.thin \
155                 -text {Use thin pack (for slow network connections)} \
156                 -variable push_thin
157         grid $w.options.thin -columnspan 2 -sticky w
158         checkbutton $w.options.tags \
159                 -text {Include tags} \
160                 -variable push_tags
161         grid $w.options.tags -columnspan 2 -sticky w
162         grid columnconfigure $w.options 1 -weight 1
163         pack $w.options -anchor nw -fill x -pady 5 -padx 5
164
165         set push_url {}
166         set push_thin 0
167         set push_tags 0
168
169         bind $w <Visibility> "grab $w; focus $w.buttons.create"
170         bind $w <Key-Escape> "destroy $w"
171         bind $w <Key-Return> [list start_push_anywhere_action $w]
172         wm title $w "[appname] ([reponame]): Push"
173         tkwait window $w
174 }