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