]>
Commit | Line | Data |
---|---|---|
ab08b363 SP |
1 | # git-gui Git repository chooser |
2 | # Copyright (C) 2007 Shawn Pearce | |
3 | ||
4 | class choose_repository { | |
5 | ||
ab08b363 SP |
6 | field top |
7 | field w | |
8 | field w_body ; # Widget holding the center content | |
9 | field w_next ; # Next button | |
28e86952 | 10 | field w_quit ; # Quit button |
ab08b363 | 11 | field o_cons ; # Console object (if active) |
d9c6469f JG |
12 | |
13 | # Status mega-widget instance during _do_clone2 (used by _copy_files and | |
14 | # _link_files). Widget is destroyed before _do_clone2 calls | |
15 | # _do_clone_checkout | |
16 | field o_status | |
17 | ||
18 | # Operation displayed by status mega-widget during _do_clone_checkout => | |
19 | # _readtree_wait => _postcheckout_wait => _do_clone_submodules => | |
20 | # _do_validate_submodule_cloning. The status mega-widget is a different | |
21 | # instance than that stored in $o_status in earlier operations. | |
22 | field o_status_op | |
23 | ||
ab08b363 | 24 | field w_types ; # List of type buttons in clone |
24f7c64b | 25 | field w_recentlist ; # Listbox containing recent repositories |
3baee1f3 | 26 | field w_localpath ; # Entry widget bound to local_path |
ab08b363 | 27 | |
ab08b363 SP |
28 | field done 0 ; # Finished picking the repository? |
29 | field local_path {} ; # Where this repository is locally | |
30 | field origin_url {} ; # Where we are cloning from | |
31 | field origin_name origin ; # What we shall call 'origin' | |
32 | field clone_type hardlink ; # Type of clone to construct | |
2202b8b8 | 33 | field recursive true ; # Recursive cloning flag |
ab08b363 | 34 | field readtree_err ; # Error output from read-tree (if any) |
24f7c64b | 35 | field sorted_recent ; # recent repositories (sorted) |
ab08b363 SP |
36 | |
37 | constructor pick {} { | |
c80d7be5 | 38 | global M1T M1B use_ttk NS |
ab08b363 | 39 | |
a8656045 PT |
40 | if {[set maxrecent [get_config gui.maxrecentrepo]] eq {}} { |
41 | set maxrecent 10 | |
42 | } | |
43 | ||
c80d7be5 | 44 | make_dialog top w |
ab08b363 SP |
45 | wm title $top [mc "Git Gui"] |
46 | ||
47 | if {$top eq {.}} { | |
48 | menu $w.mbar -tearoff 0 | |
49 | $top configure -menu $w.mbar | |
50 | ||
9c1b1b1e | 51 | set m_repo $w.mbar.repository |
ab08b363 SP |
52 | $w.mbar add cascade \ |
53 | -label [mc Repository] \ | |
9c1b1b1e SP |
54 | -menu $m_repo |
55 | menu $m_repo | |
ab08b363 SP |
56 | |
57 | if {[is_MacOSX]} { | |
442b3caa | 58 | $w.mbar add cascade -label Apple -menu .mbar.apple |
ab08b363 SP |
59 | menu $w.mbar.apple |
60 | $w.mbar.apple add command \ | |
61 | -label [mc "About %s" [appname]] \ | |
62 | -command do_about | |
e29c0d10 AG |
63 | $w.mbar.apple add command \ |
64 | -label [mc "Show SSH Key"] \ | |
65 | -command do_ssh_key | |
ab08b363 SP |
66 | } else { |
67 | $w.mbar add cascade -label [mc Help] -menu $w.mbar.help | |
68 | menu $w.mbar.help | |
69 | $w.mbar.help add command \ | |
70 | -label [mc "About %s" [appname]] \ | |
71 | -command do_about | |
e29c0d10 AG |
72 | $w.mbar.help add command \ |
73 | -label [mc "Show SSH Key"] \ | |
74 | -command do_ssh_key | |
ab08b363 SP |
75 | } |
76 | ||
ab08b363 SP |
77 | wm protocol $top WM_DELETE_WINDOW exit |
78 | bind $top <$M1B-q> exit | |
79 | bind $top <$M1B-Q> exit | |
80 | bind $top <Key-Escape> exit | |
81 | } else { | |
82 | wm geometry $top "+[winfo rootx .]+[winfo rooty .]" | |
83 | bind $top <Key-Escape> [list destroy $top] | |
9c1b1b1e | 84 | set m_repo {} |
ab08b363 SP |
85 | } |
86 | ||
281fdf69 | 87 | pack [git_logo $w.git_logo] -side left -fill y -padx 10 -pady 10 |
ab08b363 SP |
88 | |
89 | set w_body $w.body | |
28e86952 | 90 | set opts $w_body.options |
c80d7be5 | 91 | ${NS}::frame $w_body |
28e86952 SP |
92 | text $opts \ |
93 | -cursor $::cursor_ptr \ | |
94 | -relief flat \ | |
c80d7be5 | 95 | -background [get_bg_color $w_body] \ |
28e86952 SP |
96 | -wrap none \ |
97 | -spacing1 5 \ | |
98 | -width 50 \ | |
99 | -height 3 | |
100 | pack $opts -anchor w -fill x | |
101 | ||
102 | $opts tag conf link_new -foreground blue -underline 1 | |
103 | $opts tag bind link_new <1> [cb _next new] | |
104 | $opts insert end [mc "Create New Repository"] link_new | |
105 | $opts insert end "\n" | |
9c1b1b1e SP |
106 | if {$m_repo ne {}} { |
107 | $m_repo add command \ | |
108 | -command [cb _next new] \ | |
109 | -accelerator $M1T-N \ | |
110 | -label [mc "New..."] | |
914c4d4d SP |
111 | bind $top <$M1B-n> [cb _next new] |
112 | bind $top <$M1B-N> [cb _next new] | |
9c1b1b1e | 113 | } |
28e86952 SP |
114 | |
115 | $opts tag conf link_clone -foreground blue -underline 1 | |
116 | $opts tag bind link_clone <1> [cb _next clone] | |
117 | $opts insert end [mc "Clone Existing Repository"] link_clone | |
118 | $opts insert end "\n" | |
9c1b1b1e | 119 | if {$m_repo ne {}} { |
85123549 PT |
120 | if {[tk windowingsystem] eq "win32"} { |
121 | set key L | |
122 | } else { | |
123 | set key C | |
124 | } | |
9c1b1b1e SP |
125 | $m_repo add command \ |
126 | -command [cb _next clone] \ | |
85123549 | 127 | -accelerator $M1T-$key \ |
9c1b1b1e | 128 | -label [mc "Clone..."] |
85123549 PT |
129 | bind $top <$M1B-[string tolower $key]> [cb _next clone] |
130 | bind $top <$M1B-[string toupper $key]> [cb _next clone] | |
9c1b1b1e | 131 | } |
28e86952 SP |
132 | |
133 | $opts tag conf link_open -foreground blue -underline 1 | |
134 | $opts tag bind link_open <1> [cb _next open] | |
135 | $opts insert end [mc "Open Existing Repository"] link_open | |
136 | $opts insert end "\n" | |
9c1b1b1e SP |
137 | if {$m_repo ne {}} { |
138 | $m_repo add command \ | |
139 | -command [cb _next open] \ | |
140 | -accelerator $M1T-O \ | |
141 | -label [mc "Open..."] | |
914c4d4d SP |
142 | bind $top <$M1B-o> [cb _next open] |
143 | bind $top <$M1B-O> [cb _next open] | |
9c1b1b1e | 144 | } |
24f7c64b | 145 | |
28d1b11a SP |
146 | $opts conf -state disabled |
147 | ||
24f7c64b SP |
148 | set sorted_recent [_get_recentrepos] |
149 | if {[llength $sorted_recent] > 0} { | |
9c1b1b1e SP |
150 | if {$m_repo ne {}} { |
151 | $m_repo add separator | |
152 | $m_repo add command \ | |
153 | -state disabled \ | |
154 | -label [mc "Recent Repositories"] | |
155 | } | |
156 | ||
746df946 PO |
157 | if {[set lenrecent [llength $sorted_recent]] < $maxrecent} { |
158 | set lenrecent $maxrecent | |
159 | } | |
160 | ||
c80d7be5 PT |
161 | ${NS}::label $w_body.space |
162 | ${NS}::label $w_body.recentlabel \ | |
24f7c64b SP |
163 | -anchor w \ |
164 | -text [mc "Open Recent Repository:"] | |
165 | set w_recentlist $w_body.recentlist | |
166 | text $w_recentlist \ | |
167 | -cursor $::cursor_ptr \ | |
168 | -relief flat \ | |
c80d7be5 | 169 | -background [get_bg_color $w_body.recentlabel] \ |
24f7c64b SP |
170 | -wrap none \ |
171 | -width 50 \ | |
746df946 | 172 | -height $lenrecent |
24f7c64b SP |
173 | $w_recentlist tag conf link \ |
174 | -foreground blue \ | |
175 | -underline 1 | |
82dd4e04 | 176 | set home $::env(HOME) |
82dd4e04 | 177 | set home "[file normalize $home]/" |
24f7c64b SP |
178 | set hlen [string length $home] |
179 | foreach p $sorted_recent { | |
9c1b1b1e | 180 | set path $p |
24f7c64b | 181 | if {[string equal -length $hlen $home $p]} { |
82dd4e04 | 182 | set p "~/[string range $p $hlen end]" |
24f7c64b SP |
183 | } |
184 | regsub -all "\n" $p "\\n" p | |
185 | $w_recentlist insert end $p link | |
186 | $w_recentlist insert end "\n" | |
9c1b1b1e SP |
187 | |
188 | if {$m_repo ne {}} { | |
189 | $m_repo add command \ | |
190 | -command [cb _open_recent_path $path] \ | |
191 | -label " $p" | |
192 | } | |
24f7c64b SP |
193 | } |
194 | $w_recentlist conf -state disabled | |
195 | $w_recentlist tag bind link <1> [cb _open_recent %x,%y] | |
196 | pack $w_body.space -anchor w -fill x | |
197 | pack $w_body.recentlabel -anchor w -fill x | |
198 | pack $w_recentlist -anchor w -fill x | |
199 | } | |
a7cb8f58 | 200 | pack $w_body -fill x -padx 10 -pady 10 |
ab08b363 | 201 | |
c80d7be5 | 202 | ${NS}::frame $w.buttons |
ab08b363 | 203 | set w_next $w.buttons.next |
28e86952 | 204 | set w_quit $w.buttons.quit |
c80d7be5 | 205 | ${NS}::button $w_quit \ |
ab08b363 SP |
206 | -text [mc "Quit"] \ |
207 | -command exit | |
28e86952 | 208 | pack $w_quit -side right -padx 5 |
ab08b363 SP |
209 | pack $w.buttons -side bottom -fill x -padx 10 -pady 10 |
210 | ||
9c1b1b1e SP |
211 | if {$m_repo ne {}} { |
212 | $m_repo add separator | |
213 | $m_repo add command \ | |
214 | -label [mc Quit] \ | |
215 | -command exit \ | |
216 | -accelerator $M1T-Q | |
217 | } | |
218 | ||
ab08b363 SP |
219 | bind $top <Return> [cb _invoke_next] |
220 | bind $top <Visibility> " | |
a7cb8f58 | 221 | [cb _center] |
ab08b363 SP |
222 | grab $top |
223 | focus $top | |
a7cb8f58 | 224 | bind $top <Visibility> {} |
ab08b363 | 225 | " |
354e114d | 226 | wm deiconify $top |
ab08b363 SP |
227 | tkwait variable @done |
228 | ||
c80d7be5 | 229 | grab release $top |
ab08b363 SP |
230 | if {$top eq {.}} { |
231 | eval destroy [winfo children $top] | |
ab08b363 SP |
232 | } |
233 | } | |
234 | ||
a7cb8f58 SP |
235 | method _center {} { |
236 | set nx [winfo reqwidth $top] | |
237 | set ny [winfo reqheight $top] | |
238 | set rx [expr {([winfo screenwidth $top] - $nx) / 3}] | |
239 | set ry [expr {([winfo screenheight $top] - $ny) / 3}] | |
240 | wm geometry $top [format {+%d+%d} $rx $ry] | |
ab08b363 SP |
241 | } |
242 | ||
243 | method _invoke_next {} { | |
244 | if {[winfo exists $w_next]} { | |
245 | uplevel #0 [$w_next cget -command] | |
246 | } | |
247 | } | |
248 | ||
24f7c64b SP |
249 | proc _get_recentrepos {} { |
250 | set recent [list] | |
3202c68e | 251 | foreach p [lsort -unique [get_config gui.recentrepo]] { |
24f7c64b SP |
252 | if {[_is_git [file join $p .git]]} { |
253 | lappend recent $p | |
3c6a2870 CB |
254 | } else { |
255 | _unset_recentrepo $p | |
24f7c64b SP |
256 | } |
257 | } | |
3202c68e | 258 | return $recent |
24f7c64b SP |
259 | } |
260 | ||
261 | proc _unset_recentrepo {p} { | |
262 | regsub -all -- {([()\[\]{}\.^$+*?\\])} $p {\\\1} p | |
e670fce1 | 263 | catch {git config --global --unset-all gui.recentrepo "^$p\$"} |
3c6a2870 | 264 | load_config 1 |
24f7c64b SP |
265 | } |
266 | ||
267 | proc _append_recentrepos {path} { | |
268 | set path [file normalize $path] | |
269 | set recent [get_config gui.recentrepo] | |
270 | ||
271 | if {[lindex $recent end] eq $path} { | |
272 | return | |
273 | } | |
274 | ||
275 | set i [lsearch $recent $path] | |
276 | if {$i >= 0} { | |
277 | _unset_recentrepo $path | |
24f7c64b SP |
278 | } |
279 | ||
24f7c64b | 280 | git config --global --add gui.recentrepo $path |
3c6a2870 | 281 | load_config 1 |
e670fce1 | 282 | set recent [get_config gui.recentrepo] |
24f7c64b | 283 | |
a8656045 PT |
284 | if {[set maxrecent [get_config gui.maxrecentrepo]] eq {}} { |
285 | set maxrecent 10 | |
286 | } | |
287 | ||
288 | while {[llength $recent] > $maxrecent} { | |
24f7c64b | 289 | _unset_recentrepo [lindex $recent 0] |
e670fce1 | 290 | set recent [get_config gui.recentrepo] |
24f7c64b SP |
291 | } |
292 | } | |
293 | ||
294 | method _open_recent {xy} { | |
295 | set id [lindex [split [$w_recentlist index @$xy] .] 0] | |
296 | set local_path [lindex $sorted_recent [expr {$id - 1}]] | |
297 | _do_open2 $this | |
298 | } | |
299 | ||
9c1b1b1e SP |
300 | method _open_recent_path {p} { |
301 | set local_path $p | |
302 | _do_open2 $this | |
303 | } | |
304 | ||
28e86952 | 305 | method _next {action} { |
c80d7be5 | 306 | global NS |
ab08b363 | 307 | destroy $w_body |
28e86952 | 308 | if {![winfo exists $w_next]} { |
c80d7be5 | 309 | ${NS}::button $w_next -default active |
ed05e9f6 PT |
310 | set pos -before |
311 | if {[tk windowingsystem] eq "win32"} { set pos -after } | |
312 | pack $w_next -side right -padx 5 $pos $w_quit | |
28e86952 | 313 | } |
ab08b363 SP |
314 | _do_$action $this |
315 | } | |
316 | ||
317 | method _write_local_path {args} { | |
318 | if {$local_path eq {}} { | |
319 | $w_next conf -state disabled | |
320 | } else { | |
321 | $w_next conf -state normal | |
322 | } | |
323 | } | |
324 | ||
325 | method _git_init {} { | |
ab08b363 SP |
326 | if {[catch {file mkdir $local_path} err]} { |
327 | error_popup [strcat \ | |
328 | [mc "Failed to create repository %s:" $local_path] \ | |
329 | "\n\n$err"] | |
330 | return 0 | |
331 | } | |
332 | ||
333 | if {[catch {cd $local_path} err]} { | |
334 | error_popup [strcat \ | |
335 | [mc "Failed to create repository %s:" $local_path] \ | |
336 | "\n\n$err"] | |
337 | return 0 | |
338 | } | |
339 | ||
340 | if {[catch {git init} err]} { | |
341 | error_popup [strcat \ | |
342 | [mc "Failed to create repository %s:" $local_path] \ | |
343 | "\n\n$err"] | |
344 | return 0 | |
345 | } | |
346 | ||
24f7c64b | 347 | _append_recentrepos [pwd] |
ab08b363 SP |
348 | set ::_gitdir .git |
349 | set ::_prefix {} | |
350 | return 1 | |
351 | } | |
352 | ||
83da0139 RR |
353 | proc _is_git {path {outdir_var ""}} { |
354 | if {$outdir_var ne ""} { | |
355 | upvar 1 $outdir_var outdir | |
356 | } | |
a7473956 MT |
357 | if {[catch {set outdir [git rev-parse --resolve-git-dir $path]}]} { |
358 | return 0 | |
ba6c761e | 359 | } |
a7473956 | 360 | return 1 |
ab08b363 SP |
361 | } |
362 | ||
ba6c761e SP |
363 | proc _objdir {path} { |
364 | set objdir [file join $path .git objects] | |
365 | if {[file isdirectory $objdir]} { | |
366 | return $objdir | |
367 | } | |
368 | ||
369 | set objdir [file join $path objects] | |
370 | if {[file isdirectory $objdir]} { | |
371 | return $objdir | |
372 | } | |
373 | ||
ba6c761e SP |
374 | return {} |
375 | } | |
376 | ||
ab08b363 SP |
377 | ###################################################################### |
378 | ## | |
379 | ## Create New Repository | |
380 | ||
381 | method _do_new {} { | |
c80d7be5 | 382 | global use_ttk NS |
ab08b363 SP |
383 | $w_next conf \ |
384 | -state disabled \ | |
385 | -command [cb _do_new2] \ | |
386 | -text [mc "Create"] | |
387 | ||
c80d7be5 PT |
388 | ${NS}::frame $w_body |
389 | ${NS}::label $w_body.h \ | |
390 | -font font_uibold -anchor center \ | |
ab08b363 SP |
391 | -text [mc "Create New Repository"] |
392 | pack $w_body.h -side top -fill x -pady 10 | |
393 | pack $w_body -fill x -padx 10 | |
394 | ||
c80d7be5 PT |
395 | ${NS}::frame $w_body.where |
396 | ${NS}::label $w_body.where.l -text [mc "Directory:"] | |
397 | ${NS}::entry $w_body.where.t \ | |
ab08b363 | 398 | -textvariable @local_path \ |
ab08b363 | 399 | -width 50 |
c80d7be5 | 400 | ${NS}::button $w_body.where.b \ |
ab08b363 SP |
401 | -text [mc "Browse"] \ |
402 | -command [cb _new_local_path] | |
3baee1f3 | 403 | set w_localpath $w_body.where.t |
ab08b363 | 404 | |
95dcfa36 | 405 | grid $w_body.where.l $w_body.where.t $w_body.where.b -sticky ew |
ab08b363 SP |
406 | pack $w_body.where -fill x |
407 | ||
379f84b8 MH |
408 | grid columnconfigure $w_body.where 1 -weight 1 |
409 | ||
ab08b363 | 410 | trace add variable @local_path write [cb _write_local_path] |
580b73de | 411 | bind $w_body.h <Destroy> [list trace remove variable @local_path write [cb _write_local_path]] |
ab08b363 SP |
412 | update |
413 | focus $w_body.where.t | |
414 | } | |
415 | ||
416 | method _new_local_path {} { | |
417 | if {$local_path ne {}} { | |
418 | set p [file dirname $local_path] | |
419 | } else { | |
df128139 | 420 | set p [pwd] |
ab08b363 SP |
421 | } |
422 | ||
423 | set p [tk_chooseDirectory \ | |
424 | -initialdir $p \ | |
425 | -parent $top \ | |
426 | -title [mc "Git Repository"] \ | |
427 | -mustexist false] | |
428 | if {$p eq {}} return | |
429 | ||
430 | set p [file normalize $p] | |
d36a8f73 | 431 | if {![_new_ok $p]} { |
ab08b363 SP |
432 | return |
433 | } | |
434 | set local_path $p | |
3baee1f3 | 435 | $w_localpath icursor end |
ab08b363 SP |
436 | } |
437 | ||
438 | method _do_new2 {} { | |
d36a8f73 SP |
439 | if {![_new_ok $local_path]} { |
440 | return | |
441 | } | |
ab08b363 SP |
442 | if {![_git_init $this]} { |
443 | return | |
444 | } | |
445 | set done 1 | |
446 | } | |
447 | ||
d36a8f73 SP |
448 | proc _new_ok {p} { |
449 | if {[file isdirectory $p]} { | |
450 | if {[_is_git [file join $p .git]]} { | |
451 | error_popup [mc "Directory %s already exists." $p] | |
452 | return 0 | |
453 | } | |
454 | } elseif {[file exists $p]} { | |
455 | error_popup [mc "File %s already exists." $p] | |
456 | return 0 | |
457 | } | |
458 | return 1 | |
459 | } | |
460 | ||
ab08b363 SP |
461 | ###################################################################### |
462 | ## | |
463 | ## Clone Existing Repository | |
464 | ||
465 | method _do_clone {} { | |
c80d7be5 | 466 | global use_ttk NS |
ab08b363 SP |
467 | $w_next conf \ |
468 | -state disabled \ | |
469 | -command [cb _do_clone2] \ | |
470 | -text [mc "Clone"] | |
471 | ||
c80d7be5 PT |
472 | ${NS}::frame $w_body |
473 | ${NS}::label $w_body.h \ | |
474 | -font font_uibold -anchor center \ | |
ab08b363 SP |
475 | -text [mc "Clone Existing Repository"] |
476 | pack $w_body.h -side top -fill x -pady 10 | |
477 | pack $w_body -fill x -padx 10 | |
478 | ||
479 | set args $w_body.args | |
c80d7be5 | 480 | ${NS}::frame $w_body.args |
ab08b363 SP |
481 | pack $args -fill both |
482 | ||
c80d7be5 PT |
483 | ${NS}::label $args.origin_l -text [mc "Source Location:"] |
484 | ${NS}::entry $args.origin_t \ | |
ab08b363 | 485 | -textvariable @origin_url \ |
ab08b363 | 486 | -width 50 |
c80d7be5 | 487 | ${NS}::button $args.origin_b \ |
ab08b363 SP |
488 | -text [mc "Browse"] \ |
489 | -command [cb _open_origin] | |
490 | grid $args.origin_l $args.origin_t $args.origin_b -sticky ew | |
491 | ||
c80d7be5 PT |
492 | ${NS}::label $args.where_l -text [mc "Target Directory:"] |
493 | ${NS}::entry $args.where_t \ | |
ab08b363 | 494 | -textvariable @local_path \ |
ab08b363 | 495 | -width 50 |
c80d7be5 | 496 | ${NS}::button $args.where_b \ |
ab08b363 SP |
497 | -text [mc "Browse"] \ |
498 | -command [cb _new_local_path] | |
499 | grid $args.where_l $args.where_t $args.where_b -sticky ew | |
3baee1f3 | 500 | set w_localpath $args.where_t |
ab08b363 | 501 | |
c80d7be5 PT |
502 | ${NS}::label $args.type_l -text [mc "Clone Type:"] |
503 | ${NS}::frame $args.type_f | |
ab08b363 | 504 | set w_types [list] |
c80d7be5 | 505 | lappend w_types [${NS}::radiobutton $args.type_f.hardlink \ |
ab08b363 | 506 | -state disabled \ |
ab08b363 SP |
507 | -text [mc "Standard (Fast, Semi-Redundant, Hardlinks)"] \ |
508 | -variable @clone_type \ | |
509 | -value hardlink] | |
c80d7be5 | 510 | lappend w_types [${NS}::radiobutton $args.type_f.full \ |
ab08b363 | 511 | -state disabled \ |
ab08b363 SP |
512 | -text [mc "Full Copy (Slower, Redundant Backup)"] \ |
513 | -variable @clone_type \ | |
514 | -value full] | |
c80d7be5 | 515 | lappend w_types [${NS}::radiobutton $args.type_f.shared \ |
ab08b363 | 516 | -state disabled \ |
ab08b363 SP |
517 | -text [mc "Shared (Fastest, Not Recommended, No Backup)"] \ |
518 | -variable @clone_type \ | |
519 | -value shared] | |
520 | foreach r $w_types { | |
521 | pack $r -anchor w | |
522 | } | |
2202b8b8 HG |
523 | ${NS}::checkbutton $args.type_f.recursive \ |
524 | -text [mc "Recursively clone submodules too"] \ | |
525 | -variable @recursive \ | |
526 | -onvalue true -offvalue false | |
41a5f0b5 | 527 | pack $args.type_f.recursive -anchor w |
ab08b363 SP |
528 | grid $args.type_l $args.type_f -sticky new |
529 | ||
530 | grid columnconfigure $args 1 -weight 1 | |
531 | ||
532 | trace add variable @local_path write [cb _update_clone] | |
533 | trace add variable @origin_url write [cb _update_clone] | |
580b73de SP |
534 | bind $w_body.h <Destroy> " |
535 | [list trace remove variable @local_path write [cb _update_clone]] | |
536 | [list trace remove variable @origin_url write [cb _update_clone]] | |
537 | " | |
ab08b363 SP |
538 | update |
539 | focus $args.origin_t | |
540 | } | |
541 | ||
542 | method _open_origin {} { | |
543 | if {$origin_url ne {} && [file isdirectory $origin_url]} { | |
544 | set p $origin_url | |
545 | } else { | |
df128139 | 546 | set p [pwd] |
ab08b363 SP |
547 | } |
548 | ||
549 | set p [tk_chooseDirectory \ | |
550 | -initialdir $p \ | |
551 | -parent $top \ | |
552 | -title [mc "Git Repository"] \ | |
553 | -mustexist true] | |
554 | if {$p eq {}} return | |
555 | ||
556 | set p [file normalize $p] | |
557 | if {![_is_git [file join $p .git]] && ![_is_git $p]} { | |
558 | error_popup [mc "Not a Git repository: %s" [file tail $p]] | |
559 | return | |
560 | } | |
561 | set origin_url $p | |
562 | } | |
563 | ||
564 | method _update_clone {args} { | |
565 | if {$local_path ne {} && $origin_url ne {}} { | |
566 | $w_next conf -state normal | |
567 | } else { | |
568 | $w_next conf -state disabled | |
569 | } | |
570 | ||
571 | if {$origin_url ne {} && | |
572 | ( [_is_git [file join $origin_url .git]] | |
573 | || [_is_git $origin_url])} { | |
574 | set e normal | |
575 | if {[[lindex $w_types 0] cget -state] eq {disabled}} { | |
576 | set clone_type hardlink | |
577 | } | |
578 | } else { | |
579 | set e disabled | |
580 | set clone_type full | |
581 | } | |
582 | ||
583 | foreach r $w_types { | |
584 | $r conf -state $e | |
585 | } | |
586 | } | |
587 | ||
588 | method _do_clone2 {} { | |
589 | if {[file isdirectory $origin_url]} { | |
590 | set origin_url [file normalize $origin_url] | |
591 | } | |
592 | ||
593 | if {$clone_type eq {hardlink} && ![file isdirectory $origin_url]} { | |
594 | error_popup [mc "Standard only available for local repository."] | |
595 | return | |
596 | } | |
597 | if {$clone_type eq {shared} && ![file isdirectory $origin_url]} { | |
598 | error_popup [mc "Shared only available for local repository."] | |
599 | return | |
600 | } | |
601 | ||
602 | if {$clone_type eq {hardlink} || $clone_type eq {shared}} { | |
ba6c761e SP |
603 | set objdir [_objdir $origin_url] |
604 | if {$objdir eq {}} { | |
605 | error_popup [mc "Not a Git repository: %s" [file tail $origin_url]] | |
606 | return | |
ab08b363 SP |
607 | } |
608 | } | |
609 | ||
610 | set giturl $origin_url | |
ab08b363 | 611 | |
d36a8f73 SP |
612 | if {[file exists $local_path]} { |
613 | error_popup [mc "Location %s already exists." $local_path] | |
614 | return | |
615 | } | |
616 | ||
ab08b363 SP |
617 | if {![_git_init $this]} return |
618 | set local_path [pwd] | |
619 | ||
620 | if {[catch { | |
621 | git config remote.$origin_name.url $giturl | |
622 | git config remote.$origin_name.fetch +refs/heads/*:refs/remotes/$origin_name/* | |
623 | } err]} { | |
624 | error_popup [strcat [mc "Failed to configure origin"] "\n\n$err"] | |
625 | return | |
626 | } | |
627 | ||
628 | destroy $w_body $w_next | |
629 | ||
630 | switch -exact -- $clone_type { | |
631 | hardlink { | |
d9c6469f | 632 | set o_status [status_bar::two_line $w_body] |
a7cb8f58 | 633 | pack $w_body -fill x -padx 10 -pady 10 |
81d4d3dd | 634 | |
d9c6469f | 635 | set status_op [$o_status start \ |
81d4d3dd | 636 | [mc "Counting objects"] \ |
d9c6469f | 637 | [mc "buckets"]] |
81d4d3dd SP |
638 | update |
639 | ||
85f77ead SP |
640 | if {[file exists [file join $objdir info alternates]]} { |
641 | set pwd [pwd] | |
642 | if {[catch { | |
643 | file mkdir [gitdir objects info] | |
644 | set f_in [open [file join $objdir info alternates] r] | |
645 | set f_cp [open [gitdir objects info alternates] w] | |
646 | fconfigure $f_in -translation binary -encoding binary | |
647 | fconfigure $f_cp -translation binary -encoding binary | |
648 | cd $objdir | |
649 | while {[gets $f_in line] >= 0} { | |
7145c654 | 650 | puts $f_cp [file normalize $line] |
85f77ead SP |
651 | } |
652 | close $f_in | |
653 | close $f_cp | |
654 | cd $pwd | |
655 | } err]} { | |
656 | catch {cd $pwd} | |
657 | _clone_failed $this [mc "Unable to copy objects/info/alternates: %s" $err] | |
d9c6469f | 658 | $status_op stop |
85f77ead SP |
659 | return |
660 | } | |
661 | } | |
662 | ||
ab08b363 | 663 | set tolink [list] |
81d4d3dd SP |
664 | set buckets [glob \ |
665 | -tails \ | |
666 | -nocomplain \ | |
667 | -directory [file join $objdir] ??] | |
668 | set bcnt [expr {[llength $buckets] + 2}] | |
669 | set bcur 1 | |
d9c6469f | 670 | $status_op update $bcur $bcnt |
81d4d3dd SP |
671 | update |
672 | ||
ab08b363 SP |
673 | file mkdir [file join .git objects pack] |
674 | foreach i [glob -tails -nocomplain \ | |
675 | -directory [file join $objdir pack] *] { | |
676 | lappend tolink [file join pack $i] | |
677 | } | |
d9c6469f | 678 | $status_op update [incr bcur] $bcnt |
81d4d3dd SP |
679 | update |
680 | ||
681 | foreach i $buckets { | |
ab08b363 SP |
682 | file mkdir [file join .git objects $i] |
683 | foreach j [glob -tails -nocomplain \ | |
684 | -directory [file join $objdir $i] *] { | |
685 | lappend tolink [file join $i $j] | |
686 | } | |
d9c6469f | 687 | $status_op update [incr bcur] $bcnt |
81d4d3dd | 688 | update |
ab08b363 | 689 | } |
d9c6469f | 690 | $status_op stop |
ab08b363 SP |
691 | |
692 | if {$tolink eq {}} { | |
693 | info_popup [strcat \ | |
694 | [mc "Nothing to clone from %s." $origin_url] \ | |
695 | "\n" \ | |
696 | [mc "The 'master' branch has not been initialized."] \ | |
697 | ] | |
81d4d3dd | 698 | destroy $w_body |
ab08b363 SP |
699 | set done 1 |
700 | return | |
701 | } | |
702 | ||
ab08b363 SP |
703 | set i [lindex $tolink 0] |
704 | if {[catch { | |
705 | file link -hard \ | |
706 | [file join .git objects $i] \ | |
707 | [file join $objdir $i] | |
708 | } err]} { | |
40f86af0 | 709 | info_popup [mc "Hardlinks are unavailable. Falling back to copying."] |
ab08b363 SP |
710 | set i [_copy_files $this $objdir $tolink] |
711 | } else { | |
712 | set i [_link_files $this $objdir [lrange $tolink 1 end]] | |
713 | } | |
714 | if {!$i} return | |
715 | ||
716 | destroy $w_body | |
d9c6469f JG |
717 | |
718 | set o_status {} | |
ab08b363 SP |
719 | } |
720 | full { | |
721 | set o_cons [console::embed \ | |
722 | $w_body \ | |
723 | [mc "Cloning from %s" $origin_url]] | |
724 | pack $w_body -fill both -expand 1 -padx 10 | |
725 | $o_cons exec \ | |
726 | [list git fetch --no-tags -k $origin_name] \ | |
727 | [cb _do_clone_tags] | |
728 | } | |
729 | shared { | |
730 | set fd [open [gitdir objects info alternates] w] | |
731 | fconfigure $fd -translation binary | |
732 | puts $fd $objdir | |
733 | close $fd | |
734 | } | |
735 | } | |
736 | ||
737 | if {$clone_type eq {hardlink} || $clone_type eq {shared}} { | |
738 | if {![_clone_refs $this]} return | |
739 | set pwd [pwd] | |
740 | if {[catch { | |
741 | cd $origin_url | |
742 | set HEAD [git rev-parse --verify HEAD^0] | |
743 | } err]} { | |
744 | _clone_failed $this [mc "Not a Git repository: %s" [file tail $origin_url]] | |
745 | return 0 | |
746 | } | |
747 | cd $pwd | |
748 | _do_clone_checkout $this $HEAD | |
749 | } | |
750 | } | |
751 | ||
752 | method _copy_files {objdir tocopy} { | |
d9c6469f | 753 | set status_op [$o_status start \ |
ab08b363 | 754 | [mc "Copying objects"] \ |
d9c6469f | 755 | [mc "KiB"]] |
ab08b363 SP |
756 | set tot 0 |
757 | set cmp 0 | |
758 | foreach p $tocopy { | |
759 | incr tot [file size [file join $objdir $p]] | |
760 | } | |
761 | foreach p $tocopy { | |
762 | if {[catch { | |
763 | set f_in [open [file join $objdir $p] r] | |
764 | set f_cp [open [file join .git objects $p] w] | |
765 | fconfigure $f_in -translation binary -encoding binary | |
766 | fconfigure $f_cp -translation binary -encoding binary | |
767 | ||
768 | while {![eof $f_in]} { | |
769 | incr cmp [fcopy $f_in $f_cp -size 16384] | |
d9c6469f | 770 | $status_op update \ |
ab08b363 SP |
771 | [expr {$cmp / 1024}] \ |
772 | [expr {$tot / 1024}] | |
773 | update | |
774 | } | |
775 | ||
776 | close $f_in | |
777 | close $f_cp | |
778 | } err]} { | |
779 | _clone_failed $this [mc "Unable to copy object: %s" $err] | |
d9c6469f | 780 | $status_op stop |
ab08b363 SP |
781 | return 0 |
782 | } | |
783 | } | |
d9c6469f | 784 | $status_op stop |
ab08b363 SP |
785 | return 1 |
786 | } | |
787 | ||
788 | method _link_files {objdir tolink} { | |
789 | set total [llength $tolink] | |
d9c6469f | 790 | set status_op [$o_status start \ |
ab08b363 | 791 | [mc "Linking objects"] \ |
d9c6469f | 792 | [mc "objects"]] |
ab08b363 SP |
793 | for {set i 0} {$i < $total} {} { |
794 | set p [lindex $tolink $i] | |
795 | if {[catch { | |
796 | file link -hard \ | |
797 | [file join .git objects $p] \ | |
798 | [file join $objdir $p] | |
799 | } err]} { | |
800 | _clone_failed $this [mc "Unable to hardlink object: %s" $err] | |
d9c6469f | 801 | $status_op stop |
ab08b363 SP |
802 | return 0 |
803 | } | |
804 | ||
805 | incr i | |
806 | if {$i % 5 == 0} { | |
d9c6469f | 807 | $status_op update $i $total |
ab08b363 SP |
808 | update |
809 | } | |
810 | } | |
d9c6469f | 811 | $status_op stop |
ab08b363 SP |
812 | return 1 |
813 | } | |
814 | ||
815 | method _clone_refs {} { | |
816 | set pwd [pwd] | |
817 | if {[catch {cd $origin_url} err]} { | |
818 | error_popup [mc "Not a Git repository: %s" [file tail $origin_url]] | |
819 | return 0 | |
820 | } | |
821 | set fd_in [git_read for-each-ref \ | |
822 | --tcl \ | |
823 | {--format=list %(refname) %(objectname) %(*objectname)}] | |
824 | cd $pwd | |
825 | ||
826 | set fd [open [gitdir packed-refs] w] | |
827 | fconfigure $fd -translation binary | |
828 | puts $fd "# pack-refs with: peeled" | |
829 | while {[gets $fd_in line] >= 0} { | |
830 | set line [eval $line] | |
831 | set refn [lindex $line 0] | |
832 | set robj [lindex $line 1] | |
833 | set tobj [lindex $line 2] | |
834 | ||
835 | if {[regsub ^refs/heads/ $refn \ | |
836 | "refs/remotes/$origin_name/" refn]} { | |
837 | puts $fd "$robj $refn" | |
838 | } elseif {[string match refs/tags/* $refn]} { | |
839 | puts $fd "$robj $refn" | |
840 | if {$tobj ne {}} { | |
841 | puts $fd "^$tobj" | |
842 | } | |
843 | } | |
844 | } | |
845 | close $fd_in | |
846 | close $fd | |
847 | return 1 | |
848 | } | |
849 | ||
850 | method _do_clone_tags {ok} { | |
851 | if {$ok} { | |
852 | $o_cons exec \ | |
853 | [list git fetch --tags -k $origin_name] \ | |
854 | [cb _do_clone_HEAD] | |
855 | } else { | |
856 | $o_cons done $ok | |
857 | _clone_failed $this [mc "Cannot fetch branches and objects. See console output for details."] | |
858 | } | |
859 | } | |
860 | ||
861 | method _do_clone_HEAD {ok} { | |
862 | if {$ok} { | |
863 | $o_cons exec \ | |
864 | [list git fetch $origin_name HEAD] \ | |
865 | [cb _do_clone_full_end] | |
866 | } else { | |
867 | $o_cons done $ok | |
868 | _clone_failed $this [mc "Cannot fetch tags. See console output for details."] | |
869 | } | |
870 | } | |
871 | ||
872 | method _do_clone_full_end {ok} { | |
873 | $o_cons done $ok | |
874 | ||
875 | if {$ok} { | |
876 | destroy $w_body | |
877 | ||
878 | set HEAD {} | |
879 | if {[file exists [gitdir FETCH_HEAD]]} { | |
880 | set fd [open [gitdir FETCH_HEAD] r] | |
881 | while {[gets $fd line] >= 0} { | |
882 | if {[regexp "^(.{40})\t\t" $line line HEAD]} { | |
883 | break | |
884 | } | |
885 | } | |
886 | close $fd | |
887 | } | |
888 | ||
889 | catch {git pack-refs} | |
890 | _do_clone_checkout $this $HEAD | |
891 | } else { | |
892 | _clone_failed $this [mc "Cannot determine HEAD. See console output for details."] | |
893 | } | |
894 | } | |
895 | ||
896 | method _clone_failed {{why {}}} { | |
897 | if {[catch {file delete -force $local_path} err]} { | |
898 | set why [strcat \ | |
899 | $why \ | |
900 | "\n\n" \ | |
901 | [mc "Unable to cleanup %s" $local_path] \ | |
902 | "\n\n" \ | |
903 | $err] | |
904 | } | |
905 | if {$why ne {}} { | |
906 | update | |
907 | error_popup [strcat [mc "Clone failed."] "\n" $why] | |
908 | } | |
909 | } | |
910 | ||
911 | method _do_clone_checkout {HEAD} { | |
912 | if {$HEAD eq {}} { | |
913 | info_popup [strcat \ | |
914 | [mc "No default branch obtained."] \ | |
915 | "\n" \ | |
916 | [mc "The 'master' branch has not been initialized."] \ | |
917 | ] | |
918 | set done 1 | |
919 | return | |
920 | } | |
921 | if {[catch { | |
922 | git update-ref HEAD $HEAD^0 | |
923 | } err]} { | |
924 | info_popup [strcat \ | |
925 | [mc "Cannot resolve %s as a commit." $HEAD^0] \ | |
926 | "\n $err" \ | |
927 | "\n" \ | |
928 | [mc "The 'master' branch has not been initialized."] \ | |
929 | ] | |
930 | set done 1 | |
931 | return | |
932 | } | |
933 | ||
d9c6469f | 934 | set status [status_bar::two_line $w_body] |
a7cb8f58 | 935 | pack $w_body -fill x -padx 10 -pady 10 |
d9c6469f JG |
936 | |
937 | # We start the status operation here. | |
938 | # | |
939 | # This function calls _readtree_wait as a callback. | |
940 | # | |
941 | # _readtree_wait in turn either calls _do_clone_submodules directly, | |
942 | # or calls _postcheckout_wait as a callback which then calls | |
943 | # _do_clone_submodules. | |
944 | # | |
945 | # _do_clone_submodules calls _do_validate_submodule_cloning. | |
946 | # | |
947 | # _do_validate_submodule_cloning stops the status operation. | |
948 | # | |
949 | # There are no other calls into this chain from other code. | |
950 | ||
951 | set o_status_op [$status start \ | |
ab08b363 | 952 | [mc "Creating working directory"] \ |
d9c6469f | 953 | [mc "files"]] |
ab08b363 SP |
954 | |
955 | set readtree_err {} | |
956 | set fd [git_read --stderr read-tree \ | |
957 | -m \ | |
958 | -u \ | |
959 | -v \ | |
960 | HEAD \ | |
961 | HEAD \ | |
962 | ] | |
963 | fconfigure $fd -blocking 0 -translation binary | |
964 | fileevent $fd readable [cb _readtree_wait $fd] | |
965 | } | |
966 | ||
967 | method _readtree_wait {fd} { | |
968 | set buf [read $fd] | |
d9c6469f | 969 | $o_status_op update_meter $buf |
ab08b363 SP |
970 | append readtree_err $buf |
971 | ||
972 | fconfigure $fd -blocking 1 | |
973 | if {![eof $fd]} { | |
974 | fconfigure $fd -blocking 0 | |
975 | return | |
976 | } | |
977 | ||
978 | if {[catch {close $fd}]} { | |
979 | set err $readtree_err | |
980 | regsub {^fatal: } $err {} err | |
981 | error_popup [strcat \ | |
982 | [mc "Initial file checkout failed."] \ | |
983 | "\n\n$err"] | |
984 | return | |
985 | } | |
986 | ||
b4c813bc JL |
987 | # -- Run the post-checkout hook. |
988 | # | |
989 | set fd_ph [githook_read post-checkout [string repeat 0 40] \ | |
990 | [git rev-parse HEAD] 1] | |
991 | if {$fd_ph ne {}} { | |
992 | global pch_error | |
993 | set pch_error {} | |
994 | fconfigure $fd_ph -blocking 0 -translation binary -eofchar {} | |
995 | fileevent $fd_ph readable [cb _postcheckout_wait $fd_ph] | |
996 | } else { | |
2202b8b8 | 997 | _do_clone_submodules $this |
b4c813bc JL |
998 | } |
999 | } | |
1000 | ||
1001 | method _postcheckout_wait {fd_ph} { | |
1002 | global pch_error | |
1003 | ||
1004 | append pch_error [read $fd_ph] | |
1005 | fconfigure $fd_ph -blocking 1 | |
1006 | if {[eof $fd_ph]} { | |
1007 | if {[catch {close $fd_ph}]} { | |
1008 | hook_failed_popup post-checkout $pch_error 0 | |
1009 | } | |
1010 | unset pch_error | |
2202b8b8 | 1011 | _do_clone_submodules $this |
b4c813bc JL |
1012 | return |
1013 | } | |
1014 | fconfigure $fd_ph -blocking 0 | |
ab08b363 SP |
1015 | } |
1016 | ||
d9c6469f JG |
1017 | method _do_clone_submodules {} { |
1018 | if {$recursive eq {true}} { | |
1019 | $o_status_op stop | |
1020 | set o_status_op {} | |
1021 | ||
1022 | destroy $w_body | |
1023 | ||
1024 | set o_cons [console::embed \ | |
1025 | $w_body \ | |
1026 | [mc "Cloning submodules"]] | |
1027 | pack $w_body -fill both -expand 1 -padx 10 | |
1028 | $o_cons exec \ | |
1029 | [list git submodule update --init --recursive] \ | |
1030 | [cb _do_validate_submodule_cloning] | |
1031 | } else { | |
1032 | set done 1 | |
1033 | } | |
1034 | } | |
1035 | ||
1036 | method _do_validate_submodule_cloning {ok} { | |
1037 | if {$ok} { | |
1038 | $o_cons done $ok | |
1039 | set done 1 | |
1040 | } else { | |
1041 | _clone_failed $this [mc "Cannot clone submodules."] | |
1042 | } | |
1043 | } | |
1044 | ||
ab08b363 SP |
1045 | ###################################################################### |
1046 | ## | |
1047 | ## Open Existing Repository | |
1048 | ||
1049 | method _do_open {} { | |
c80d7be5 | 1050 | global NS |
ab08b363 SP |
1051 | $w_next conf \ |
1052 | -state disabled \ | |
1053 | -command [cb _do_open2] \ | |
1054 | -text [mc "Open"] | |
1055 | ||
c80d7be5 PT |
1056 | ${NS}::frame $w_body |
1057 | ${NS}::label $w_body.h \ | |
1058 | -font font_uibold -anchor center \ | |
ab08b363 SP |
1059 | -text [mc "Open Existing Repository"] |
1060 | pack $w_body.h -side top -fill x -pady 10 | |
1061 | pack $w_body -fill x -padx 10 | |
1062 | ||
c80d7be5 PT |
1063 | ${NS}::frame $w_body.where |
1064 | ${NS}::label $w_body.where.l -text [mc "Repository:"] | |
1065 | ${NS}::entry $w_body.where.t \ | |
ab08b363 | 1066 | -textvariable @local_path \ |
ab08b363 | 1067 | -width 50 |
c80d7be5 | 1068 | ${NS}::button $w_body.where.b \ |
ab08b363 SP |
1069 | -text [mc "Browse"] \ |
1070 | -command [cb _open_local_path] | |
1071 | ||
95dcfa36 | 1072 | grid $w_body.where.l $w_body.where.t $w_body.where.b -sticky ew |
ab08b363 SP |
1073 | pack $w_body.where -fill x |
1074 | ||
379f84b8 MH |
1075 | grid columnconfigure $w_body.where 1 -weight 1 |
1076 | ||
ab08b363 | 1077 | trace add variable @local_path write [cb _write_local_path] |
580b73de | 1078 | bind $w_body.h <Destroy> [list trace remove variable @local_path write [cb _write_local_path]] |
ab08b363 SP |
1079 | update |
1080 | focus $w_body.where.t | |
1081 | } | |
1082 | ||
1083 | method _open_local_path {} { | |
1084 | if {$local_path ne {}} { | |
1085 | set p $local_path | |
1086 | } else { | |
df128139 | 1087 | set p [pwd] |
ab08b363 SP |
1088 | } |
1089 | ||
1090 | set p [tk_chooseDirectory \ | |
1091 | -initialdir $p \ | |
1092 | -parent $top \ | |
1093 | -title [mc "Git Repository"] \ | |
1094 | -mustexist true] | |
1095 | if {$p eq {}} return | |
1096 | ||
1097 | set p [file normalize $p] | |
1098 | if {![_is_git [file join $p .git]]} { | |
1099 | error_popup [mc "Not a Git repository: %s" [file tail $p]] | |
1100 | return | |
1101 | } | |
1102 | set local_path $p | |
1103 | } | |
1104 | ||
1105 | method _do_open2 {} { | |
83da0139 | 1106 | if {![_is_git [file join $local_path .git] actualgit]} { |
ab08b363 SP |
1107 | error_popup [mc "Not a Git repository: %s" [file tail $local_path]] |
1108 | return | |
1109 | } | |
1110 | ||
1111 | if {[catch {cd $local_path} err]} { | |
1112 | error_popup [strcat \ | |
1113 | [mc "Failed to open repository %s:" $local_path] \ | |
1114 | "\n\n$err"] | |
1115 | return | |
1116 | } | |
1117 | ||
24f7c64b | 1118 | _append_recentrepos [pwd] |
83da0139 | 1119 | set ::_gitdir $actualgit |
ab08b363 SP |
1120 | set ::_prefix {} |
1121 | set done 1 | |
1122 | } | |
1123 | ||
1124 | } |