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