Merge branch 'maint' of git://repo.or.cz/git-gui into maint
[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 }