1# git-gui Git repository chooser
2# Copyright (C) 2007 Shawn Pearce
3class choose_repository {
5image create photo ::choose_repository::git_logo -data {
7R0lGODlh3wA9AMIHAMAAAMIKCsMKCgCAAN/v3/319f///wAAACH5BAEKAAcALAAAAADfAD0AAAP+
8aLrc/jDKSau9OOvNu/9gKI5kaZ5oqq5s675wLM90bd94ru987//AoHBILBqPyKSSFGg6n9BoUwCR
9Wq3Ux3X7zC4Xg7B4HN4Bzui0eo2GsN9wN3ye/jLI+IGZzpfz535/b3ZgeWN7goMPiXGLjGyECoaH
10Oo+QjpZ1mJlnkQaTYhigZR6cmg6mbZucnqN6F64fqZ2rmYGskbGwo7Kzt7a1lq28u6AfBcjJysvM
11yRDN0NHP0dTKniS619pG2dveQd3f4jzh40eu3eh5EOrq5kPtk3fxoQ/0xO9A93jz9+z7hvKBA1hP
120r5/BMkIJIfvU0OE8opFXDjQWCGLEsplfEj+sUc6jg40RhDZMcdHjCNBpkQ5IuAHlx5gtjg5cWVN
13CiRjrnu5Uye/FzRlQhQ6IWcHohqQZlCKImhPm0ztqeT506dCqlddOK0K9SnOqVYphS141OuKrVm7
14cv3KUkRUC28rxMXW0KjDthvxgphb1GxSvynQilWblu1Nt4BFJZY4mIVgskMXhwQrN+GryQkj+zvx
15mFTew5/5Eo6nmV5p0pzrUr4LejTkv5mlxsZMsKlqvf1an3691PJud7JrpwZFoDgBu3Zzi/6NjrlI
16y5cD+74IPbrydowPBgfofPXe6QarW6eOuvLsBtC7424JnnX67djhtr++mTb3s+3Fe0avvexl2g3L
17laaPd4QECN9+HBioFYF2KMjff7AVtkNyBUpmnoQRNjYhg184SN94GfI2U38LeUieiIpBOGJ9JVpo
18mIYhIggUiQKZGB6GvanoGI0l9ejjj0AGKeSQRBZp5JFIJqnkkkxOkAAAOw==
19}
20field top
22field w
23field w_body ; # Widget holding the center content
24field w_next ; # Next button
25field o_cons ; # Console object (if active)
26field w_types ; # List of type buttons in clone
27field action new ; # What action are we going to perform?
29field done 0 ; # Finished picking the repository?
30field local_path {} ; # Where this repository is locally
31field origin_url {} ; # Where we are cloning from
32field origin_name origin ; # What we shall call 'origin'
33field clone_type hardlink ; # Type of clone to construct
34field readtree_err ; # Error output from read-tree (if any)
35constructor pick {} {
37 global M1T M1B
38 make_toplevel top w
40 wm title $top [mc "Git Gui"]
41 if {$top eq {.}} {
43 menu $w.mbar -tearoff 0
44 $top configure -menu $w.mbar
45 $w.mbar add cascade \
47 -label [mc Repository] \
48 -menu $w.mbar.repository
49 menu $w.mbar.repository
50 $w.mbar.repository add command \
51 -label [mc Quit] \
52 -command exit \
53 -accelerator $M1T-Q
54 if {[is_MacOSX]} {
56 $w.mbar add cascade -label [mc Apple] -menu .mbar.apple
57 menu $w.mbar.apple
58 $w.mbar.apple add command \
59 -label [mc "About %s" [appname]] \
60 -command do_about
61 } else {
62 $w.mbar add cascade -label [mc Help] -menu $w.mbar.help
63 menu $w.mbar.help
64 $w.mbar.help add command \
65 -label [mc "About %s" [appname]] \
66 -command do_about
67 }
68 _center $top 500 350
70 wm protocol $top WM_DELETE_WINDOW exit
71 bind $top <$M1B-q> exit
72 bind $top <$M1B-Q> exit
73 bind $top <Key-Escape> exit
74 } else {
75 wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
76 bind $top <Key-Escape> [list destroy $top]
77 }
78 label $w.git_logo \
80 -borderwidth 1 \
81 -relief sunken \
82 -background white \
83 -image ::choose_repository::git_logo
84 pack $w.git_logo -side top -fill x -padx 20 -pady 20
85 set w_body $w.body
87 frame $w_body
88 radiobutton $w_body.new \
89 -anchor w \
90 -text [mc "Create New Repository"] \
91 -variable @action \
92 -value new
93 radiobutton $w_body.clone \
94 -anchor w \
95 -text [mc "Clone Existing Repository"] \
96 -variable @action \
97 -value clone
98 radiobutton $w_body.open \
99 -anchor w \
100 -text [mc "Open Existing Repository"] \
101 -variable @action \
102 -value open
103 pack $w_body.new -anchor w -fill x
104 pack $w_body.clone -anchor w -fill x
105 pack $w_body.open -anchor w -fill x
106 pack $w_body -fill x -padx 10
107 frame $w.buttons
109 set w_next $w.buttons.next
110 button $w_next \
111 -default active \
112 -text [mc "Next >"] \
113 -command [cb _next]
114 pack $w_next -side right -padx 5
115 button $w.buttons.quit \
116 -text [mc "Quit"] \
117 -command exit
118 pack $w.buttons.quit -side right -padx 5
119 pack $w.buttons -side bottom -fill x -padx 10 -pady 10
120 bind $top <Return> [cb _invoke_next]
122 bind $top <Visibility> "
123 grab $top
124 focus $top
125 "
126 wm deiconify $top
127 tkwait variable @done
128 if {$top eq {.}} {
130 eval destroy [winfo children $top]
131 _center $top 500 600
132 }
133}
134proc _home {} {
136 if {[catch {set h $::env(HOME)}]
137 || ![file isdirectory $h]} {
138 set h .
139 }
140 return $h
141}
142proc _center {top nx ny} {
144 set rx [expr {([winfo screenwidth $top] - $nx) / 2}]
145 set ry [expr {([winfo screenheight $top] - $ny) / 2}]
146 wm geometry $top [format {%dx%d+%d+%d} $nx $ny $rx $ry]
147}
148method _invoke_next {} {
150 if {[winfo exists $w_next]} {
151 uplevel #0 [$w_next cget -command]
152 }
153}
154method _next {} {
156 destroy $w_body
157 _do_$action $this
158}
159method _write_local_path {args} {
161 if {$local_path eq {}} {
162 $w_next conf -state disabled
163 } else {
164 $w_next conf -state normal
165 }
166}
167method _git_init {} {
169 if {[file exists $local_path]} {
170 error_popup [mc "Location %s already exists." $local_path]
171 return 0
172 }
173 if {[catch {file mkdir $local_path} err]} {
175 error_popup [strcat \
176 [mc "Failed to create repository %s:" $local_path] \
177 "\n\n$err"]
178 return 0
179 }
180 if {[catch {cd $local_path} err]} {
182 error_popup [strcat \
183 [mc "Failed to create repository %s:" $local_path] \
184 "\n\n$err"]
185 return 0
186 }
187 if {[catch {git init} err]} {
189 error_popup [strcat \
190 [mc "Failed to create repository %s:" $local_path] \
191 "\n\n$err"]
192 return 0
193 }
194 set ::_gitdir .git
196 set ::_prefix {}
197 return 1
198}
199proc _is_git {path} {
201 if {[file exists [file join $path HEAD]]
202 && [file exists [file join $path objects]]
203 && [file exists [file join $path config]]} {
204 return 1
205 }
206 return 0
207}
208######################################################################
210##
211## Create New Repository
212method _do_new {} {
214 $w_next conf \
215 -state disabled \
216 -command [cb _do_new2] \
217 -text [mc "Create"]
218 frame $w_body
220 label $w_body.h \
221 -font font_uibold \
222 -text [mc "Create New Repository"]
223 pack $w_body.h -side top -fill x -pady 10
224 pack $w_body -fill x -padx 10
225 frame $w_body.where
227 label $w_body.where.l -text [mc "Directory:"]
228 entry $w_body.where.t \
229 -textvariable @local_path \
230 -font font_diff \
231 -width 50
232 button $w_body.where.b \
233 -text [mc "Browse"] \
234 -command [cb _new_local_path]
235 pack $w_body.where.b -side right
237 pack $w_body.where.l -side left
238 pack $w_body.where.t -fill x
239 pack $w_body.where -fill x
240 trace add variable @local_path write [cb _write_local_path]
242 update
243 focus $w_body.where.t
244}
245method _new_local_path {} {
247 if {$local_path ne {}} {
248 set p [file dirname $local_path]
249 } else {
250 set p [_home]
251 }
252 set p [tk_chooseDirectory \
254 -initialdir $p \
255 -parent $top \
256 -title [mc "Git Repository"] \
257 -mustexist false]
258 if {$p eq {}} return
259 set p [file normalize $p]
261 if {[file isdirectory $p]} {
262 foreach i [glob \
263 -directory $p \
264 -tails \
265 -nocomplain \
266 * .*] {
267 switch -- $i {
268 . continue
269 .. continue
270 default {
271 error_popup [mc "Directory %s already exists." $p]
272 return
273 }
274 }
275 }
276 if {[catch {file delete $p} err]} {
277 error_popup [strcat \
278 [mc "Directory %s already exists." $p] \
279 "\n\n$err"]
280 return
281 }
282 } elseif {[file exists $p]} {
283 error_popup [mc "File %s already exists." $p]
284 return
285 }
286 set local_path $p
287}
288method _do_new2 {} {
290 if {![_git_init $this]} {
291 return
292 }
293 set done 1
294}
295######################################################################
297##
298## Clone Existing Repository
299method _do_clone {} {
301 $w_next conf \
302 -state disabled \
303 -command [cb _do_clone2] \
304 -text [mc "Clone"]
305 frame $w_body
307 label $w_body.h \
308 -font font_uibold \
309 -text [mc "Clone Existing Repository"]
310 pack $w_body.h -side top -fill x -pady 10
311 pack $w_body -fill x -padx 10
312 set args $w_body.args
314 frame $w_body.args
315 pack $args -fill both
316 label $args.origin_l -text [mc "URL:"]
318 entry $args.origin_t \
319 -textvariable @origin_url \
320 -font font_diff \
321 -width 50
322 button $args.origin_b \
323 -text [mc "Browse"] \
324 -command [cb _open_origin]
325 grid $args.origin_l $args.origin_t $args.origin_b -sticky ew
326 label $args.where_l -text [mc "Directory:"]
328 entry $args.where_t \
329 -textvariable @local_path \
330 -font font_diff \
331 -width 50
332 button $args.where_b \
333 -text [mc "Browse"] \
334 -command [cb _new_local_path]
335 grid $args.where_l $args.where_t $args.where_b -sticky ew
336 label $args.type_l -text [mc "Clone Type:"]
338 frame $args.type_f
339 set w_types [list]
340 lappend w_types [radiobutton $args.type_f.hardlink \
341 -state disabled \
342 -anchor w \
343 -text [mc "Standard (Fast, Semi-Redundant, Hardlinks)"] \
344 -variable @clone_type \
345 -value hardlink]
346 lappend w_types [radiobutton $args.type_f.full \
347 -state disabled \
348 -anchor w \
349 -text [mc "Full Copy (Slower, Redundant Backup)"] \
350 -variable @clone_type \
351 -value full]
352 lappend w_types [radiobutton $args.type_f.shared \
353 -state disabled \
354 -anchor w \
355 -text [mc "Shared (Fastest, Not Recommended, No Backup)"] \
356 -variable @clone_type \
357 -value shared]
358 foreach r $w_types {
359 pack $r -anchor w
360 }
361 grid $args.type_l $args.type_f -sticky new
362 grid columnconfigure $args 1 -weight 1
364 trace add variable @local_path write [cb _update_clone]
366 trace add variable @origin_url write [cb _update_clone]
367 update
368 focus $args.origin_t
369}
370method _open_origin {} {
372 if {$origin_url ne {} && [file isdirectory $origin_url]} {
373 set p $origin_url
374 } else {
375 set p [_home]
376 }
377 set p [tk_chooseDirectory \
379 -initialdir $p \
380 -parent $top \
381 -title [mc "Git Repository"] \
382 -mustexist true]
383 if {$p eq {}} return
384 set p [file normalize $p]
386 if {![_is_git [file join $p .git]] && ![_is_git $p]} {
387 error_popup [mc "Not a Git repository: %s" [file tail $p]]
388 return
389 }
390 set origin_url $p
391}
392method _update_clone {args} {
394 if {$local_path ne {} && $origin_url ne {}} {
395 $w_next conf -state normal
396 } else {
397 $w_next conf -state disabled
398 }
399 if {$origin_url ne {} &&
401 ( [_is_git [file join $origin_url .git]]
402 || [_is_git $origin_url])} {
403 set e normal
404 if {[[lindex $w_types 0] cget -state] eq {disabled}} {
405 set clone_type hardlink
406 }
407 } else {
408 set e disabled
409 set clone_type full
410 }
411 foreach r $w_types {
413 $r conf -state $e
414 }
415}
416method _do_clone2 {} {
418 if {[file isdirectory $origin_url]} {
419 set origin_url [file normalize $origin_url]
420 }
421 if {$clone_type eq {hardlink} && ![file isdirectory $origin_url]} {
423 error_popup [mc "Standard only available for local repository."]
424 return
425 }
426 if {$clone_type eq {shared} && ![file isdirectory $origin_url]} {
427 error_popup [mc "Shared only available for local repository."]
428 return
429 }
430 if {$clone_type eq {hardlink} || $clone_type eq {shared}} {
432 set objdir [file join $origin_url .git objects]
433 if {![file isdirectory $objdir]} {
434 set objdir [file join $origin_url objects]
435 if {![file isdirectory $objdir]} {
436 error_popup [mc "Not a Git repository: %s" [file tail $origin_url]]
437 return
438 }
439 }
440 }
441 set giturl $origin_url
443 if {[is_Cygwin] && [file isdirectory $giturl]} {
444 set giturl [exec cygpath --unix --absolute $giturl]
445 if {$clone_type eq {shared}} {
446 set objdir [exec cygpath --unix --absolute $objdir]
447 }
448 }
449 if {![_git_init $this]} return
451 set local_path [pwd]
452 if {[catch {
454 git config remote.$origin_name.url $giturl
455 git config remote.$origin_name.fetch +refs/heads/*:refs/remotes/$origin_name/*
456 } err]} {
457 error_popup [strcat [mc "Failed to configure origin"] "\n\n$err"]
458 return
459 }
460 destroy $w_body $w_next
462 switch -exact -- $clone_type {
464 hardlink {
465 set o_cons [status_bar::new $w_body]
466 pack $w_body -fill x -padx 10
467 $o_cons start \
469 [mc "Counting objects"] \
470 [mc "buckets"]
471 update
472 if {[file exists [file join $objdir info alternates]]} {
474 set pwd [pwd]
475 if {[catch {
476 file mkdir [gitdir objects info]
477 set f_in [open [file join $objdir info alternates] r]
478 set f_cp [open [gitdir objects info alternates] w]
479 fconfigure $f_in -translation binary -encoding binary
480 fconfigure $f_cp -translation binary -encoding binary
481 cd $objdir
482 while {[gets $f_in line] >= 0} {
483 if {[is_Cygwin]} {
484 puts $f_cp [exec cygpath --unix --absolute $line]
485 } else {
486 puts $f_cp [file normalize $line]
487 }
488 }
489 close $f_in
490 close $f_cp
491 cd $pwd
492 } err]} {
493 catch {cd $pwd}
494 _clone_failed $this [mc "Unable to copy objects/info/alternates: %s" $err]
495 return
496 }
497 }
498 set tolink [list]
500 set buckets [glob \
501 -tails \
502 -nocomplain \
503 -directory [file join $objdir] ??]
504 set bcnt [expr {[llength $buckets] + 2}]
505 set bcur 1
506 $o_cons update $bcur $bcnt
507 update
508 file mkdir [file join .git objects pack]
510 foreach i [glob -tails -nocomplain \
511 -directory [file join $objdir pack] *] {
512 lappend tolink [file join pack $i]
513 }
514 $o_cons update [incr bcur] $bcnt
515 update
516 foreach i $buckets {
518 file mkdir [file join .git objects $i]
519 foreach j [glob -tails -nocomplain \
520 -directory [file join $objdir $i] *] {
521 lappend tolink [file join $i $j]
522 }
523 $o_cons update [incr bcur] $bcnt
524 update
525 }
526 $o_cons stop
527 if {$tolink eq {}} {
529 info_popup [strcat \
530 [mc "Nothing to clone from %s." $origin_url] \
531 "\n" \
532 [mc "The 'master' branch has not been initialized."] \
533 ]
534 destroy $w_body
535 set done 1
536 return
537 }
538 set i [lindex $tolink 0]
540 if {[catch {
541 file link -hard \
542 [file join .git objects $i] \
543 [file join $objdir $i]
544 } err]} {
545 info_popup [mc "Hardlinks are unavailable. Falling back to copying."]
546 set i [_copy_files $this $objdir $tolink]
547 } else {
548 set i [_link_files $this $objdir [lrange $tolink 1 end]]
549 }
550 if {!$i} return
551 destroy $w_body
553 }
554 full {
555 set o_cons [console::embed \
556 $w_body \
557 [mc "Cloning from %s" $origin_url]]
558 pack $w_body -fill both -expand 1 -padx 10
559 $o_cons exec \
560 [list git fetch --no-tags -k $origin_name] \
561 [cb _do_clone_tags]
562 }
563 shared {
564 set fd [open [gitdir objects info alternates] w]
565 fconfigure $fd -translation binary
566 puts $fd $objdir
567 close $fd
568 }
569 }
570 if {$clone_type eq {hardlink} || $clone_type eq {shared}} {
572 if {![_clone_refs $this]} return
573 set pwd [pwd]
574 if {[catch {
575 cd $origin_url
576 set HEAD [git rev-parse --verify HEAD^0]
577 } err]} {
578 _clone_failed $this [mc "Not a Git repository: %s" [file tail $origin_url]]
579 return 0
580 }
581 cd $pwd
582 _do_clone_checkout $this $HEAD
583 }
584}
585method _copy_files {objdir tocopy} {
587 $o_cons start \
588 [mc "Copying objects"] \
589 [mc "KiB"]
590 set tot 0
591 set cmp 0
592 foreach p $tocopy {
593 incr tot [file size [file join $objdir $p]]
594 }
595 foreach p $tocopy {
596 if {[catch {
597 set f_in [open [file join $objdir $p] r]
598 set f_cp [open [file join .git objects $p] w]
599 fconfigure $f_in -translation binary -encoding binary
600 fconfigure $f_cp -translation binary -encoding binary
601 while {![eof $f_in]} {
603 incr cmp [fcopy $f_in $f_cp -size 16384]
604 $o_cons update \
605 [expr {$cmp / 1024}] \
606 [expr {$tot / 1024}]
607 update
608 }
609 close $f_in
611 close $f_cp
612 } err]} {
613 _clone_failed $this [mc "Unable to copy object: %s" $err]
614 return 0
615 }
616 }
617 return 1
618}
619method _link_files {objdir tolink} {
621 set total [llength $tolink]
622 $o_cons start \
623 [mc "Linking objects"] \
624 [mc "objects"]
625 for {set i 0} {$i < $total} {} {
626 set p [lindex $tolink $i]
627 if {[catch {
628 file link -hard \
629 [file join .git objects $p] \
630 [file join $objdir $p]
631 } err]} {
632 _clone_failed $this [mc "Unable to hardlink object: %s" $err]
633 return 0
634 }
635 incr i
637 if {$i % 5 == 0} {
638 $o_cons update $i $total
639 update
640 }
641 }
642 return 1
643}
644method _clone_refs {} {
646 set pwd [pwd]
647 if {[catch {cd $origin_url} err]} {
648 error_popup [mc "Not a Git repository: %s" [file tail $origin_url]]
649 return 0
650 }
651 set fd_in [git_read for-each-ref \
652 --tcl \
653 {--format=list %(refname) %(objectname) %(*objectname)}]
654 cd $pwd
655 set fd [open [gitdir packed-refs] w]
657 fconfigure $fd -translation binary
658 puts $fd "# pack-refs with: peeled"
659 while {[gets $fd_in line] >= 0} {
660 set line [eval $line]
661 set refn [lindex $line 0]
662 set robj [lindex $line 1]
663 set tobj [lindex $line 2]
664 if {[regsub ^refs/heads/ $refn \
666 "refs/remotes/$origin_name/" refn]} {
667 puts $fd "$robj $refn"
668 } elseif {[string match refs/tags/* $refn]} {
669 puts $fd "$robj $refn"
670 if {$tobj ne {}} {
671 puts $fd "^$tobj"
672 }
673 }
674 }
675 close $fd_in
676 close $fd
677 return 1
678}
679method _do_clone_tags {ok} {
681 if {$ok} {
682 $o_cons exec \
683 [list git fetch --tags -k $origin_name] \
684 [cb _do_clone_HEAD]
685 } else {
686 $o_cons done $ok
687 _clone_failed $this [mc "Cannot fetch branches and objects. See console output for details."]
688 }
689}
690method _do_clone_HEAD {ok} {
692 if {$ok} {
693 $o_cons exec \
694 [list git fetch $origin_name HEAD] \
695 [cb _do_clone_full_end]
696 } else {
697 $o_cons done $ok
698 _clone_failed $this [mc "Cannot fetch tags. See console output for details."]
699 }
700}
701method _do_clone_full_end {ok} {
703 $o_cons done $ok
704 if {$ok} {
706 destroy $w_body
707 set HEAD {}
709 if {[file exists [gitdir FETCH_HEAD]]} {
710 set fd [open [gitdir FETCH_HEAD] r]
711 while {[gets $fd line] >= 0} {
712 if {[regexp "^(.{40})\t\t" $line line HEAD]} {
713 break
714 }
715 }
716 close $fd
717 }
718 catch {git pack-refs}
720 _do_clone_checkout $this $HEAD
721 } else {
722 _clone_failed $this [mc "Cannot determine HEAD. See console output for details."]
723 }
724}
725method _clone_failed {{why {}}} {
727 if {[catch {file delete -force $local_path} err]} {
728 set why [strcat \
729 $why \
730 "\n\n" \
731 [mc "Unable to cleanup %s" $local_path] \
732 "\n\n" \
733 $err]
734 }
735 if {$why ne {}} {
736 update
737 error_popup [strcat [mc "Clone failed."] "\n" $why]
738 }
739}
740method _do_clone_checkout {HEAD} {
742 if {$HEAD eq {}} {
743 info_popup [strcat \
744 [mc "No default branch obtained."] \
745 "\n" \
746 [mc "The 'master' branch has not been initialized."] \
747 ]
748 set done 1
749 return
750 }
751 if {[catch {
752 git update-ref HEAD $HEAD^0
753 } err]} {
754 info_popup [strcat \
755 [mc "Cannot resolve %s as a commit." $HEAD^0] \
756 "\n $err" \
757 "\n" \
758 [mc "The 'master' branch has not been initialized."] \
759 ]
760 set done 1
761 return
762 }
763 set o_cons [status_bar::new $w_body]
765 pack $w_body -fill x -padx 10
766 $o_cons start \
767 [mc "Creating working directory"] \
768 [mc "files"]
769 set readtree_err {}
771 set fd [git_read --stderr read-tree \
772 -m \
773 -u \
774 -v \
775 HEAD \
776 HEAD \
777 ]
778 fconfigure $fd -blocking 0 -translation binary
779 fileevent $fd readable [cb _readtree_wait $fd]
780}
781method _readtree_wait {fd} {
783 set buf [read $fd]
784 $o_cons update_meter $buf
785 append readtree_err $buf
786 fconfigure $fd -blocking 1
788 if {![eof $fd]} {
789 fconfigure $fd -blocking 0
790 return
791 }
792 if {[catch {close $fd}]} {
794 set err $readtree_err
795 regsub {^fatal: } $err {} err
796 error_popup [strcat \
797 [mc "Initial file checkout failed."] \
798 "\n\n$err"]
799 return
800 }
801 set done 1
803}
804######################################################################
806##
807## Open Existing Repository
808method _do_open {} {
810 $w_next conf \
811 -state disabled \
812 -command [cb _do_open2] \
813 -text [mc "Open"]
814 frame $w_body
816 label $w_body.h \
817 -font font_uibold \
818 -text [mc "Open Existing Repository"]
819 pack $w_body.h -side top -fill x -pady 10
820 pack $w_body -fill x -padx 10
821 frame $w_body.where
823 label $w_body.where.l -text [mc "Repository:"]
824 entry $w_body.where.t \
825 -textvariable @local_path \
826 -font font_diff \
827 -width 50
828 button $w_body.where.b \
829 -text [mc "Browse"] \
830 -command [cb _open_local_path]
831 pack $w_body.where.b -side right
833 pack $w_body.where.l -side left
834 pack $w_body.where.t -fill x
835 pack $w_body.where -fill x
836 trace add variable @local_path write [cb _write_local_path]
838 update
839 focus $w_body.where.t
840}
841method _open_local_path {} {
843 if {$local_path ne {}} {
844 set p $local_path
845 } else {
846 set p [_home]
847 }
848 set p [tk_chooseDirectory \
850 -initialdir $p \
851 -parent $top \
852 -title [mc "Git Repository"] \
853 -mustexist true]
854 if {$p eq {}} return
855 set p [file normalize $p]
857 if {![_is_git [file join $p .git]]} {
858 error_popup [mc "Not a Git repository: %s" [file tail $p]]
859 return
860 }
861 set local_path $p
862}
863method _do_open2 {} {
865 if {![_is_git [file join $local_path .git]]} {
866 error_popup [mc "Not a Git repository: %s" [file tail $local_path]]
867 return
868 }
869 if {[catch {cd $local_path} err]} {
871 error_popup [strcat \
872 [mc "Failed to open repository %s:" $local_path] \
873 "\n\n$err"]
874 return
875 }
876 set ::_gitdir .git
878 set ::_prefix {}
879 set done 1
880}
881}