eb4a6d2851c8b08f9ac41236997185ab54ebba65
1# git-gui Git repository chooser
2# Copyright (C) 2007 Shawn Pearce
3class choose_repository {
5field top
7field w
8field w_body ; # Widget holding the center content
9field w_next ; # Next button
10field w_quit ; # Quit button
11field o_cons ; # Console object (if active)
12field w_types ; # List of type buttons in clone
13field w_recentlist ; # Listbox containing recent repositories
14field done 0 ; # Finished picking the repository?
16field local_path {} ; # Where this repository is locally
17field origin_url {} ; # Where we are cloning from
18field origin_name origin ; # What we shall call 'origin'
19field clone_type hardlink ; # Type of clone to construct
20field readtree_err ; # Error output from read-tree (if any)
21field sorted_recent ; # recent repositories (sorted)
22constructor pick {} {
24 global M1T M1B
25 make_toplevel top w
27 wm title $top [mc "Git Gui"]
28 if {$top eq {.}} {
30 menu $w.mbar -tearoff 0
31 $top configure -menu $w.mbar
32 $w.mbar add cascade \
34 -label [mc Repository] \
35 -menu $w.mbar.repository
36 menu $w.mbar.repository
37 $w.mbar.repository add command \
38 -label [mc Quit] \
39 -command exit \
40 -accelerator $M1T-Q
41 if {[is_MacOSX]} {
43 $w.mbar add cascade -label [mc Apple] -menu .mbar.apple
44 menu $w.mbar.apple
45 $w.mbar.apple add command \
46 -label [mc "About %s" [appname]] \
47 -command do_about
48 } else {
49 $w.mbar add cascade -label [mc Help] -menu $w.mbar.help
50 menu $w.mbar.help
51 $w.mbar.help add command \
52 -label [mc "About %s" [appname]] \
53 -command do_about
54 }
55 wm protocol $top WM_DELETE_WINDOW exit
57 bind $top <$M1B-q> exit
58 bind $top <$M1B-Q> exit
59 bind $top <Key-Escape> exit
60 } else {
61 wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
62 bind $top <Key-Escape> [list destroy $top]
63 }
64 pack [git_logo $w.git_logo] -side left -fill y -padx 10 -pady 10
66 set w_body $w.body
68 set opts $w_body.options
69 frame $w_body
70 text $opts \
71 -cursor $::cursor_ptr \
72 -relief flat \
73 -background [$w_body cget -background] \
74 -wrap none \
75 -spacing1 5 \
76 -width 50 \
77 -height 3
78 pack $opts -anchor w -fill x
79 $opts tag conf link_new -foreground blue -underline 1
81 $opts tag bind link_new <1> [cb _next new]
82 $opts insert end [mc "Create New Repository"] link_new
83 $opts insert end "\n"
84 $opts tag conf link_clone -foreground blue -underline 1
86 $opts tag bind link_clone <1> [cb _next clone]
87 $opts insert end [mc "Clone Existing Repository"] link_clone
88 $opts insert end "\n"
89 $opts tag conf link_open -foreground blue -underline 1
91 $opts tag bind link_open <1> [cb _next open]
92 $opts insert end [mc "Open Existing Repository"] link_open
93 $opts insert end "\n"
94 set sorted_recent [_get_recentrepos]
96 if {[llength $sorted_recent] > 0} {
97 label $w_body.space
98 label $w_body.recentlabel \
99 -anchor w \
100 -text [mc "Open Recent Repository:"]
101 set w_recentlist $w_body.recentlist
102 text $w_recentlist \
103 -cursor $::cursor_ptr \
104 -relief flat \
105 -background [$w_body.recentlabel cget -background] \
106 -wrap none \
107 -width 50 \
108 -height 10
109 $w_recentlist tag conf link \
110 -foreground blue \
111 -underline 1
112 set home "[file normalize $::env(HOME)][file separator]"
113 set hlen [string length $home]
114 foreach p $sorted_recent {
115 if {[string equal -length $hlen $home $p]} {
116 set p "~[file separator][string range $p $hlen end]"
117 }
118 regsub -all "\n" $p "\\n" p
119 $w_recentlist insert end $p link
120 $w_recentlist insert end "\n"
121 }
122 $w_recentlist conf -state disabled
123 $w_recentlist tag bind link <1> [cb _open_recent %x,%y]
124 pack $w_body.space -anchor w -fill x
125 pack $w_body.recentlabel -anchor w -fill x
126 pack $w_recentlist -anchor w -fill x
127 }
128 pack $w_body -fill x -padx 10 -pady 10
129 frame $w.buttons
131 set w_next $w.buttons.next
132 set w_quit $w.buttons.quit
133 button $w_quit \
134 -text [mc "Quit"] \
135 -command exit
136 pack $w_quit -side right -padx 5
137 pack $w.buttons -side bottom -fill x -padx 10 -pady 10
138 bind $top <Return> [cb _invoke_next]
140 bind $top <Visibility> "
141 [cb _center]
142 grab $top
143 focus $top
144 bind $top <Visibility> {}
145 "
146 wm deiconify $top
147 tkwait variable @done
148 if {$top eq {.}} {
150 eval destroy [winfo children $top]
151 }
152}
153proc _home {} {
155 if {[catch {set h $::env(HOME)}]
156 || ![file isdirectory $h]} {
157 set h .
158 }
159 return $h
160}
161method _center {} {
163 set nx [winfo reqwidth $top]
164 set ny [winfo reqheight $top]
165 set rx [expr {([winfo screenwidth $top] - $nx) / 3}]
166 set ry [expr {([winfo screenheight $top] - $ny) / 3}]
167 wm geometry $top [format {+%d+%d} $rx $ry]
168}
169method _invoke_next {} {
171 if {[winfo exists $w_next]} {
172 uplevel #0 [$w_next cget -command]
173 }
174}
175proc _get_recentrepos {} {
177 set recent [list]
178 foreach p [get_config gui.recentrepo] {
179 if {[_is_git [file join $p .git]]} {
180 lappend recent $p
181 }
182 }
183 return [lsort $recent]
184}
185proc _unset_recentrepo {p} {
187 regsub -all -- {([()\[\]{}\.^$+*?\\])} $p {\\\1} p
188 git config --global --unset gui.recentrepo "^$p\$"
189}
190proc _append_recentrepos {path} {
192 set path [file normalize $path]
193 set recent [get_config gui.recentrepo]
194 if {[lindex $recent end] eq $path} {
196 return
197 }
198 set i [lsearch $recent $path]
200 if {$i >= 0} {
201 _unset_recentrepo $path
202 set recent [lreplace $recent $i $i]
203 }
204 lappend recent $path
206 git config --global --add gui.recentrepo $path
207 while {[llength $recent] > 10} {
209 _unset_recentrepo [lindex $recent 0]
210 set recent [lrange $recent 1 end]
211 }
212}
213method _open_recent {xy} {
215 set id [lindex [split [$w_recentlist index @$xy] .] 0]
216 set local_path [lindex $sorted_recent [expr {$id - 1}]]
217 _do_open2 $this
218}
219method _next {action} {
221 destroy $w_body
222 if {![winfo exists $w_next]} {
223 button $w_next -default active
224 pack $w_next -side right -padx 5 -before $w_quit
225 }
226 _do_$action $this
227}
228method _write_local_path {args} {
230 if {$local_path eq {}} {
231 $w_next conf -state disabled
232 } else {
233 $w_next conf -state normal
234 }
235}
236method _git_init {} {
238 if {[file exists $local_path]} {
239 error_popup [mc "Location %s already exists." $local_path]
240 return 0
241 }
242 if {[catch {file mkdir $local_path} err]} {
244 error_popup [strcat \
245 [mc "Failed to create repository %s:" $local_path] \
246 "\n\n$err"]
247 return 0
248 }
249 if {[catch {cd $local_path} err]} {
251 error_popup [strcat \
252 [mc "Failed to create repository %s:" $local_path] \
253 "\n\n$err"]
254 return 0
255 }
256 if {[catch {git init} err]} {
258 error_popup [strcat \
259 [mc "Failed to create repository %s:" $local_path] \
260 "\n\n$err"]
261 return 0
262 }
263 _append_recentrepos [pwd]
265 set ::_gitdir .git
266 set ::_prefix {}
267 return 1
268}
269proc _is_git {path} {
271 if {[file exists [file join $path HEAD]]
272 && [file exists [file join $path objects]]
273 && [file exists [file join $path config]]} {
274 return 1
275 }
276 return 0
277}
278######################################################################
280##
281## Create New Repository
282method _do_new {} {
284 $w_next conf \
285 -state disabled \
286 -command [cb _do_new2] \
287 -text [mc "Create"]
288 frame $w_body
290 label $w_body.h \
291 -font font_uibold \
292 -text [mc "Create New Repository"]
293 pack $w_body.h -side top -fill x -pady 10
294 pack $w_body -fill x -padx 10
295 frame $w_body.where
297 label $w_body.where.l -text [mc "Directory:"]
298 entry $w_body.where.t \
299 -textvariable @local_path \
300 -font font_diff \
301 -width 50
302 button $w_body.where.b \
303 -text [mc "Browse"] \
304 -command [cb _new_local_path]
305 pack $w_body.where.b -side right
307 pack $w_body.where.l -side left
308 pack $w_body.where.t -fill x
309 pack $w_body.where -fill x
310 trace add variable @local_path write [cb _write_local_path]
312 update
313 focus $w_body.where.t
314}
315method _new_local_path {} {
317 if {$local_path ne {}} {
318 set p [file dirname $local_path]
319 } else {
320 set p [_home]
321 }
322 set p [tk_chooseDirectory \
324 -initialdir $p \
325 -parent $top \
326 -title [mc "Git Repository"] \
327 -mustexist false]
328 if {$p eq {}} return
329 set p [file normalize $p]
331 if {[file isdirectory $p]} {
332 foreach i [glob \
333 -directory $p \
334 -tails \
335 -nocomplain \
336 * .*] {
337 switch -- $i {
338 . continue
339 .. continue
340 default {
341 error_popup [mc "Directory %s already exists." $p]
342 return
343 }
344 }
345 }
346 if {[catch {file delete $p} err]} {
347 error_popup [strcat \
348 [mc "Directory %s already exists." $p] \
349 "\n\n$err"]
350 return
351 }
352 } elseif {[file exists $p]} {
353 error_popup [mc "File %s already exists." $p]
354 return
355 }
356 set local_path $p
357}
358method _do_new2 {} {
360 if {![_git_init $this]} {
361 return
362 }
363 set done 1
364}
365######################################################################
367##
368## Clone Existing Repository
369method _do_clone {} {
371 $w_next conf \
372 -state disabled \
373 -command [cb _do_clone2] \
374 -text [mc "Clone"]
375 frame $w_body
377 label $w_body.h \
378 -font font_uibold \
379 -text [mc "Clone Existing Repository"]
380 pack $w_body.h -side top -fill x -pady 10
381 pack $w_body -fill x -padx 10
382 set args $w_body.args
384 frame $w_body.args
385 pack $args -fill both
386 label $args.origin_l -text [mc "URL:"]
388 entry $args.origin_t \
389 -textvariable @origin_url \
390 -font font_diff \
391 -width 50
392 button $args.origin_b \
393 -text [mc "Browse"] \
394 -command [cb _open_origin]
395 grid $args.origin_l $args.origin_t $args.origin_b -sticky ew
396 label $args.where_l -text [mc "Directory:"]
398 entry $args.where_t \
399 -textvariable @local_path \
400 -font font_diff \
401 -width 50
402 button $args.where_b \
403 -text [mc "Browse"] \
404 -command [cb _new_local_path]
405 grid $args.where_l $args.where_t $args.where_b -sticky ew
406 label $args.type_l -text [mc "Clone Type:"]
408 frame $args.type_f
409 set w_types [list]
410 lappend w_types [radiobutton $args.type_f.hardlink \
411 -state disabled \
412 -anchor w \
413 -text [mc "Standard (Fast, Semi-Redundant, Hardlinks)"] \
414 -variable @clone_type \
415 -value hardlink]
416 lappend w_types [radiobutton $args.type_f.full \
417 -state disabled \
418 -anchor w \
419 -text [mc "Full Copy (Slower, Redundant Backup)"] \
420 -variable @clone_type \
421 -value full]
422 lappend w_types [radiobutton $args.type_f.shared \
423 -state disabled \
424 -anchor w \
425 -text [mc "Shared (Fastest, Not Recommended, No Backup)"] \
426 -variable @clone_type \
427 -value shared]
428 foreach r $w_types {
429 pack $r -anchor w
430 }
431 grid $args.type_l $args.type_f -sticky new
432 grid columnconfigure $args 1 -weight 1
434 trace add variable @local_path write [cb _update_clone]
436 trace add variable @origin_url write [cb _update_clone]
437 update
438 focus $args.origin_t
439}
440method _open_origin {} {
442 if {$origin_url ne {} && [file isdirectory $origin_url]} {
443 set p $origin_url
444 } else {
445 set p [_home]
446 }
447 set p [tk_chooseDirectory \
449 -initialdir $p \
450 -parent $top \
451 -title [mc "Git Repository"] \
452 -mustexist true]
453 if {$p eq {}} return
454 set p [file normalize $p]
456 if {![_is_git [file join $p .git]] && ![_is_git $p]} {
457 error_popup [mc "Not a Git repository: %s" [file tail $p]]
458 return
459 }
460 set origin_url $p
461}
462method _update_clone {args} {
464 if {$local_path ne {} && $origin_url ne {}} {
465 $w_next conf -state normal
466 } else {
467 $w_next conf -state disabled
468 }
469 if {$origin_url ne {} &&
471 ( [_is_git [file join $origin_url .git]]
472 || [_is_git $origin_url])} {
473 set e normal
474 if {[[lindex $w_types 0] cget -state] eq {disabled}} {
475 set clone_type hardlink
476 }
477 } else {
478 set e disabled
479 set clone_type full
480 }
481 foreach r $w_types {
483 $r conf -state $e
484 }
485}
486method _do_clone2 {} {
488 if {[file isdirectory $origin_url]} {
489 set origin_url [file normalize $origin_url]
490 }
491 if {$clone_type eq {hardlink} && ![file isdirectory $origin_url]} {
493 error_popup [mc "Standard only available for local repository."]
494 return
495 }
496 if {$clone_type eq {shared} && ![file isdirectory $origin_url]} {
497 error_popup [mc "Shared only available for local repository."]
498 return
499 }
500 if {$clone_type eq {hardlink} || $clone_type eq {shared}} {
502 set objdir [file join $origin_url .git objects]
503 if {![file isdirectory $objdir]} {
504 set objdir [file join $origin_url objects]
505 if {![file isdirectory $objdir]} {
506 error_popup [mc "Not a Git repository: %s" [file tail $origin_url]]
507 return
508 }
509 }
510 }
511 set giturl $origin_url
513 if {[is_Cygwin] && [file isdirectory $giturl]} {
514 set giturl [exec cygpath --unix --absolute $giturl]
515 if {$clone_type eq {shared}} {
516 set objdir [exec cygpath --unix --absolute $objdir]
517 }
518 }
519 if {![_git_init $this]} return
521 set local_path [pwd]
522 if {[catch {
524 git config remote.$origin_name.url $giturl
525 git config remote.$origin_name.fetch +refs/heads/*:refs/remotes/$origin_name/*
526 } err]} {
527 error_popup [strcat [mc "Failed to configure origin"] "\n\n$err"]
528 return
529 }
530 destroy $w_body $w_next
532 switch -exact -- $clone_type {
534 hardlink {
535 set o_cons [status_bar::two_line $w_body]
536 pack $w_body -fill x -padx 10 -pady 10
537 $o_cons start \
539 [mc "Counting objects"] \
540 [mc "buckets"]
541 update
542 if {[file exists [file join $objdir info alternates]]} {
544 set pwd [pwd]
545 if {[catch {
546 file mkdir [gitdir objects info]
547 set f_in [open [file join $objdir info alternates] r]
548 set f_cp [open [gitdir objects info alternates] w]
549 fconfigure $f_in -translation binary -encoding binary
550 fconfigure $f_cp -translation binary -encoding binary
551 cd $objdir
552 while {[gets $f_in line] >= 0} {
553 if {[is_Cygwin]} {
554 puts $f_cp [exec cygpath --unix --absolute $line]
555 } else {
556 puts $f_cp [file normalize $line]
557 }
558 }
559 close $f_in
560 close $f_cp
561 cd $pwd
562 } err]} {
563 catch {cd $pwd}
564 _clone_failed $this [mc "Unable to copy objects/info/alternates: %s" $err]
565 return
566 }
567 }
568 set tolink [list]
570 set buckets [glob \
571 -tails \
572 -nocomplain \
573 -directory [file join $objdir] ??]
574 set bcnt [expr {[llength $buckets] + 2}]
575 set bcur 1
576 $o_cons update $bcur $bcnt
577 update
578 file mkdir [file join .git objects pack]
580 foreach i [glob -tails -nocomplain \
581 -directory [file join $objdir pack] *] {
582 lappend tolink [file join pack $i]
583 }
584 $o_cons update [incr bcur] $bcnt
585 update
586 foreach i $buckets {
588 file mkdir [file join .git objects $i]
589 foreach j [glob -tails -nocomplain \
590 -directory [file join $objdir $i] *] {
591 lappend tolink [file join $i $j]
592 }
593 $o_cons update [incr bcur] $bcnt
594 update
595 }
596 $o_cons stop
597 if {$tolink eq {}} {
599 info_popup [strcat \
600 [mc "Nothing to clone from %s." $origin_url] \
601 "\n" \
602 [mc "The 'master' branch has not been initialized."] \
603 ]
604 destroy $w_body
605 set done 1
606 return
607 }
608 set i [lindex $tolink 0]
610 if {[catch {
611 file link -hard \
612 [file join .git objects $i] \
613 [file join $objdir $i]
614 } err]} {
615 info_popup [mc "Hardlinks are unavailable. Falling back to copying."]
616 set i [_copy_files $this $objdir $tolink]
617 } else {
618 set i [_link_files $this $objdir [lrange $tolink 1 end]]
619 }
620 if {!$i} return
621 destroy $w_body
623 }
624 full {
625 set o_cons [console::embed \
626 $w_body \
627 [mc "Cloning from %s" $origin_url]]
628 pack $w_body -fill both -expand 1 -padx 10
629 $o_cons exec \
630 [list git fetch --no-tags -k $origin_name] \
631 [cb _do_clone_tags]
632 }
633 shared {
634 set fd [open [gitdir objects info alternates] w]
635 fconfigure $fd -translation binary
636 puts $fd $objdir
637 close $fd
638 }
639 }
640 if {$clone_type eq {hardlink} || $clone_type eq {shared}} {
642 if {![_clone_refs $this]} return
643 set pwd [pwd]
644 if {[catch {
645 cd $origin_url
646 set HEAD [git rev-parse --verify HEAD^0]
647 } err]} {
648 _clone_failed $this [mc "Not a Git repository: %s" [file tail $origin_url]]
649 return 0
650 }
651 cd $pwd
652 _do_clone_checkout $this $HEAD
653 }
654}
655method _copy_files {objdir tocopy} {
657 $o_cons start \
658 [mc "Copying objects"] \
659 [mc "KiB"]
660 set tot 0
661 set cmp 0
662 foreach p $tocopy {
663 incr tot [file size [file join $objdir $p]]
664 }
665 foreach p $tocopy {
666 if {[catch {
667 set f_in [open [file join $objdir $p] r]
668 set f_cp [open [file join .git objects $p] w]
669 fconfigure $f_in -translation binary -encoding binary
670 fconfigure $f_cp -translation binary -encoding binary
671 while {![eof $f_in]} {
673 incr cmp [fcopy $f_in $f_cp -size 16384]
674 $o_cons update \
675 [expr {$cmp / 1024}] \
676 [expr {$tot / 1024}]
677 update
678 }
679 close $f_in
681 close $f_cp
682 } err]} {
683 _clone_failed $this [mc "Unable to copy object: %s" $err]
684 return 0
685 }
686 }
687 return 1
688}
689method _link_files {objdir tolink} {
691 set total [llength $tolink]
692 $o_cons start \
693 [mc "Linking objects"] \
694 [mc "objects"]
695 for {set i 0} {$i < $total} {} {
696 set p [lindex $tolink $i]
697 if {[catch {
698 file link -hard \
699 [file join .git objects $p] \
700 [file join $objdir $p]
701 } err]} {
702 _clone_failed $this [mc "Unable to hardlink object: %s" $err]
703 return 0
704 }
705 incr i
707 if {$i % 5 == 0} {
708 $o_cons update $i $total
709 update
710 }
711 }
712 return 1
713}
714method _clone_refs {} {
716 set pwd [pwd]
717 if {[catch {cd $origin_url} err]} {
718 error_popup [mc "Not a Git repository: %s" [file tail $origin_url]]
719 return 0
720 }
721 set fd_in [git_read for-each-ref \
722 --tcl \
723 {--format=list %(refname) %(objectname) %(*objectname)}]
724 cd $pwd
725 set fd [open [gitdir packed-refs] w]
727 fconfigure $fd -translation binary
728 puts $fd "# pack-refs with: peeled"
729 while {[gets $fd_in line] >= 0} {
730 set line [eval $line]
731 set refn [lindex $line 0]
732 set robj [lindex $line 1]
733 set tobj [lindex $line 2]
734 if {[regsub ^refs/heads/ $refn \
736 "refs/remotes/$origin_name/" refn]} {
737 puts $fd "$robj $refn"
738 } elseif {[string match refs/tags/* $refn]} {
739 puts $fd "$robj $refn"
740 if {$tobj ne {}} {
741 puts $fd "^$tobj"
742 }
743 }
744 }
745 close $fd_in
746 close $fd
747 return 1
748}
749method _do_clone_tags {ok} {
751 if {$ok} {
752 $o_cons exec \
753 [list git fetch --tags -k $origin_name] \
754 [cb _do_clone_HEAD]
755 } else {
756 $o_cons done $ok
757 _clone_failed $this [mc "Cannot fetch branches and objects. See console output for details."]
758 }
759}
760method _do_clone_HEAD {ok} {
762 if {$ok} {
763 $o_cons exec \
764 [list git fetch $origin_name HEAD] \
765 [cb _do_clone_full_end]
766 } else {
767 $o_cons done $ok
768 _clone_failed $this [mc "Cannot fetch tags. See console output for details."]
769 }
770}
771method _do_clone_full_end {ok} {
773 $o_cons done $ok
774 if {$ok} {
776 destroy $w_body
777 set HEAD {}
779 if {[file exists [gitdir FETCH_HEAD]]} {
780 set fd [open [gitdir FETCH_HEAD] r]
781 while {[gets $fd line] >= 0} {
782 if {[regexp "^(.{40})\t\t" $line line HEAD]} {
783 break
784 }
785 }
786 close $fd
787 }
788 catch {git pack-refs}
790 _do_clone_checkout $this $HEAD
791 } else {
792 _clone_failed $this [mc "Cannot determine HEAD. See console output for details."]
793 }
794}
795method _clone_failed {{why {}}} {
797 if {[catch {file delete -force $local_path} err]} {
798 set why [strcat \
799 $why \
800 "\n\n" \
801 [mc "Unable to cleanup %s" $local_path] \
802 "\n\n" \
803 $err]
804 }
805 if {$why ne {}} {
806 update
807 error_popup [strcat [mc "Clone failed."] "\n" $why]
808 }
809}
810method _do_clone_checkout {HEAD} {
812 if {$HEAD eq {}} {
813 info_popup [strcat \
814 [mc "No default branch obtained."] \
815 "\n" \
816 [mc "The 'master' branch has not been initialized."] \
817 ]
818 set done 1
819 return
820 }
821 if {[catch {
822 git update-ref HEAD $HEAD^0
823 } err]} {
824 info_popup [strcat \
825 [mc "Cannot resolve %s as a commit." $HEAD^0] \
826 "\n $err" \
827 "\n" \
828 [mc "The 'master' branch has not been initialized."] \
829 ]
830 set done 1
831 return
832 }
833 set o_cons [status_bar::two_line $w_body]
835 pack $w_body -fill x -padx 10 -pady 10
836 $o_cons start \
837 [mc "Creating working directory"] \
838 [mc "files"]
839 set readtree_err {}
841 set fd [git_read --stderr read-tree \
842 -m \
843 -u \
844 -v \
845 HEAD \
846 HEAD \
847 ]
848 fconfigure $fd -blocking 0 -translation binary
849 fileevent $fd readable [cb _readtree_wait $fd]
850}
851method _readtree_wait {fd} {
853 set buf [read $fd]
854 $o_cons update_meter $buf
855 append readtree_err $buf
856 fconfigure $fd -blocking 1
858 if {![eof $fd]} {
859 fconfigure $fd -blocking 0
860 return
861 }
862 if {[catch {close $fd}]} {
864 set err $readtree_err
865 regsub {^fatal: } $err {} err
866 error_popup [strcat \
867 [mc "Initial file checkout failed."] \
868 "\n\n$err"]
869 return
870 }
871 set done 1
873}
874######################################################################
876##
877## Open Existing Repository
878method _do_open {} {
880 $w_next conf \
881 -state disabled \
882 -command [cb _do_open2] \
883 -text [mc "Open"]
884 frame $w_body
886 label $w_body.h \
887 -font font_uibold \
888 -text [mc "Open Existing Repository"]
889 pack $w_body.h -side top -fill x -pady 10
890 pack $w_body -fill x -padx 10
891 frame $w_body.where
893 label $w_body.where.l -text [mc "Repository:"]
894 entry $w_body.where.t \
895 -textvariable @local_path \
896 -font font_diff \
897 -width 50
898 button $w_body.where.b \
899 -text [mc "Browse"] \
900 -command [cb _open_local_path]
901 pack $w_body.where.b -side right
903 pack $w_body.where.l -side left
904 pack $w_body.where.t -fill x
905 pack $w_body.where -fill x
906 trace add variable @local_path write [cb _write_local_path]
908 update
909 focus $w_body.where.t
910}
911method _open_local_path {} {
913 if {$local_path ne {}} {
914 set p $local_path
915 } else {
916 set p [_home]
917 }
918 set p [tk_chooseDirectory \
920 -initialdir $p \
921 -parent $top \
922 -title [mc "Git Repository"] \
923 -mustexist true]
924 if {$p eq {}} return
925 set p [file normalize $p]
927 if {![_is_git [file join $p .git]]} {
928 error_popup [mc "Not a Git repository: %s" [file tail $p]]
929 return
930 }
931 set local_path $p
932}
933method _do_open2 {} {
935 if {![_is_git [file join $local_path .git]]} {
936 error_popup [mc "Not a Git repository: %s" [file tail $local_path]]
937 return
938 }
939 if {[catch {cd $local_path} err]} {
941 error_popup [strcat \
942 [mc "Failed to open repository %s:" $local_path] \
943 "\n\n$err"]
944 return
945 }
946 _append_recentrepos [pwd]
948 set ::_gitdir .git
949 set ::_prefix {}
950 set done 1
951}
952}