1 # git-gui Git repository chooser
2 # Copyright (C) 2007 Shawn Pearce
4 class choose_repository {
6 image create photo ::choose_repository::git_logo -data {
7 R0lGODlh3wA9AMIHAMAAAMIKCsMKCgCAAN/v3/319f///wAAACH5BAEKAAcALAAAAADfAD0AAAP+
8 aLrc/jDKSau9OOvNu/9gKI5kaZ5oqq5s675wLM90bd94ru987//AoHBILBqPyKSSFGg6n9BoUwCR
9 Wq3Ux3X7zC4Xg7B4HN4Bzui0eo2GsN9wN3ye/jLI+IGZzpfz535/b3ZgeWN7goMPiXGLjGyECoaH
10 Oo+QjpZ1mJlnkQaTYhigZR6cmg6mbZucnqN6F64fqZ2rmYGskbGwo7Kzt7a1lq28u6AfBcjJysvM
11 yRDN0NHP0dTKniS619pG2dveQd3f4jzh40eu3eh5EOrq5kPtk3fxoQ/0xO9A93jz9+z7hvKBA1hP
12 0r5/BMkIJIfvU0OE8opFXDjQWCGLEsplfEj+sUc6jg40RhDZMcdHjCNBpkQ5IuAHlx5gtjg5cWVN
13 CiRjrnu5Uye/FzRlQhQ6IWcHohqQZlCKImhPm0ztqeT506dCqlddOK0K9SnOqVYphS141OuKrVm7
14 cv3KUkRUC28rxMXW0KjDthvxgphb1GxSvynQilWblu1Nt4BFJZY4mIVgskMXhwQrN+GryQkj+zvx
15 mFTew5/5Eo6nmV5p0pzrUr4LejTkv5mlxsZMsKlqvf1an3691PJud7JrpwZFoDgBu3Zzi/6NjrlI
16 y5cD+74IPbrydowPBgfofPXe6QarW6eOuvLsBtC7424JnnX67djhtr++mTb3s+3Fe0avvexl2g3L
17 laaPd4QECN9+HBioFYF2KMjff7AVtkNyBUpmnoQRNjYhg184SN94GfI2U38LeUieiIpBOGJ9JVpo
18 mIYhIggUiQKZGB6GvanoGI0l9ejjj0AGKeSQRBZp5JFIJqnkkkxOkAAAOw==
23 field w_body ; # Widget holding the center content
24 field w_next ; # Next button
25 field o_cons ; # Console object (if active)
26 field w_types ; # List of type buttons in clone
28 field action new ; # What action are we going to perform?
29 field done 0 ; # Finished picking the repository?
30 field local_path {} ; # Where this repository is locally
31 field origin_url {} ; # Where we are cloning from
32 field origin_name origin ; # What we shall call 'origin'
33 field clone_type hardlink ; # Type of clone to construct
34 field readtree_err ; # Error output from read-tree (if any)
40 wm title $top [mc "Git Gui"]
43 menu $w.mbar -tearoff 0
44 $top configure -menu $w.mbar
47 -label [mc Repository] \
48 -menu $w.mbar.repository
49 menu $w.mbar.repository
50 $w.mbar.repository add command \
56 $w.mbar add cascade -label [mc Apple] -menu .mbar.apple
58 $w.mbar.apple add command \
59 -label [mc "About %s" [appname]] \
62 $w.mbar add cascade -label [mc Help] -menu $w.mbar.help
64 $w.mbar.help add command \
65 -label [mc "About %s" [appname]] \
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
75 wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
76 bind $top <Key-Escape> [list destroy $top]
83 -image ::choose_repository::git_logo
84 pack $w.git_logo -side top -fill x -padx 20 -pady 20
88 radiobutton $w_body.new \
90 -text [mc "Create New Repository"] \
93 radiobutton $w_body.clone \
95 -text [mc "Clone Existing Repository"] \
98 radiobutton $w_body.open \
100 -text [mc "Open Existing Repository"] \
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
109 set w_next $w.buttons.next
112 -text [mc "Next >"] \
114 pack $w_next -side right -padx 5
115 button $w.buttons.quit \
118 pack $w.buttons.quit -side right -padx 5
119 pack $w.buttons -side bottom -fill x -padx 10 -pady 10
121 bind $top <Return> [cb _invoke_next]
122 bind $top <Visibility> "
127 tkwait variable @done
130 eval destroy [winfo children $top]
136 if {[catch {set h $::env(HOME)}]
137 || ![file isdirectory $h]} {
143 proc _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]
149 method _invoke_next {} {
150 if {[winfo exists $w_next]} {
151 uplevel #0 [$w_next cget -command]
160 method _write_local_path {args} {
161 if {$local_path eq {}} {
162 $w_next conf -state disabled
164 $w_next conf -state normal
168 method _git_init {} {
169 if {[file exists $local_path]} {
170 error_popup [mc "Location %s already exists." $local_path]
174 if {[catch {file mkdir $local_path} err]} {
175 error_popup [strcat \
176 [mc "Failed to create repository %s:" $local_path] \
181 if {[catch {cd $local_path} err]} {
182 error_popup [strcat \
183 [mc "Failed to create repository %s:" $local_path] \
188 if {[catch {git init} err]} {
189 error_popup [strcat \
190 [mc "Failed to create repository %s:" $local_path] \
200 proc _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]]} {
209 ######################################################################
211 ## Create New Repository
216 -command [cb _do_new2] \
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
227 label $w_body.where.l -text [mc "Directory:"]
228 entry $w_body.where.t \
229 -textvariable @local_path \
232 button $w_body.where.b \
233 -text [mc "Browse"] \
234 -command [cb _new_local_path]
236 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
241 trace add variable @local_path write [cb _write_local_path]
243 focus $w_body.where.t
246 method _new_local_path {} {
247 if {$local_path ne {}} {
248 set p [file dirname $local_path]
253 set p [tk_chooseDirectory \
256 -title [mc "Git Repository"] \
260 set p [file normalize $p]
261 if {[file isdirectory $p]} {
271 error_popup [mc "Directory %s already exists." $p]
276 if {[catch {file delete $p} err]} {
277 error_popup [strcat \
278 [mc "Directory %s already exists." $p] \
282 } elseif {[file exists $p]} {
283 error_popup [mc "File %s already exists." $p]
290 if {![_git_init $this]} {
296 ######################################################################
298 ## Clone Existing Repository
300 method _do_clone {} {
303 -command [cb _do_clone2] \
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
313 set args $w_body.args
315 pack $args -fill both
317 label $args.origin_l -text [mc "URL:"]
318 entry $args.origin_t \
319 -textvariable @origin_url \
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
327 label $args.where_l -text [mc "Directory:"]
328 entry $args.where_t \
329 -textvariable @local_path \
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
337 label $args.type_l -text [mc "Clone Type:"]
340 lappend w_types [radiobutton $args.type_f.hardlink \
343 -text [mc "Standard (Fast, Semi-Redundant, Hardlinks)"] \
344 -variable @clone_type \
346 lappend w_types [radiobutton $args.type_f.full \
349 -text [mc "Full Copy (Slower, Redundant Backup)"] \
350 -variable @clone_type \
352 lappend w_types [radiobutton $args.type_f.shared \
355 -text [mc "Shared (Fastest, Not Recommended, No Backup)"] \
356 -variable @clone_type \
361 grid $args.type_l $args.type_f -sticky new
363 grid columnconfigure $args 1 -weight 1
365 trace add variable @local_path write [cb _update_clone]
366 trace add variable @origin_url write [cb _update_clone]
371 method _open_origin {} {
372 if {$origin_url ne {} && [file isdirectory $origin_url]} {
378 set p [tk_chooseDirectory \
381 -title [mc "Git Repository"] \
385 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]]
393 method _update_clone {args} {
394 if {$local_path ne {} && $origin_url ne {}} {
395 $w_next conf -state normal
397 $w_next conf -state disabled
400 if {$origin_url ne {} &&
401 ( [_is_git [file join $origin_url .git]]
402 || [_is_git $origin_url])} {
404 if {[[lindex $w_types 0] cget -state] eq {disabled}} {
405 set clone_type hardlink
417 method _do_clone2 {} {
418 if {[file isdirectory $origin_url]} {
419 set origin_url [file normalize $origin_url]
422 if {$clone_type eq {hardlink} && ![file isdirectory $origin_url]} {
423 error_popup [mc "Standard only available for local repository."]
426 if {$clone_type eq {shared} && ![file isdirectory $origin_url]} {
427 error_popup [mc "Shared only available for local repository."]
431 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]]
442 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]
450 if {![_git_init $this]} return
454 git config remote.$origin_name.url $giturl
455 git config remote.$origin_name.fetch +refs/heads/*:refs/remotes/$origin_name/*
457 error_popup [strcat [mc "Failed to configure origin"] "\n\n$err"]
461 destroy $w_body $w_next
463 switch -exact -- $clone_type {
465 set o_cons [status_bar::new $w_body]
466 pack $w_body -fill x -padx 10
469 [mc "Counting objects"] \
473 if {[file exists [file join $objdir info alternates]]} {
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
482 while {[gets $f_in line] >= 0} {
484 puts $f_cp [exec cygpath --unix --absolute $line]
486 puts $f_cp [file normalize $line]
494 _clone_failed $this [mc "Unable to copy objects/info/alternates: %s" $err]
503 -directory [file join $objdir] ??]
504 set bcnt [expr {[llength $buckets] + 2}]
506 $o_cons update $bcur $bcnt
509 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]
514 $o_cons update [incr bcur] $bcnt
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]
523 $o_cons update [incr bcur] $bcnt
530 [mc "Nothing to clone from %s." $origin_url] \
532 [mc "The 'master' branch has not been initialized."] \
539 set i [lindex $tolink 0]
542 [file join .git objects $i] \
543 [file join $objdir $i]
545 info_popup [mc "Hardlinks are unavailable. Falling back to copying."]
546 set i [_copy_files $this $objdir $tolink]
548 set i [_link_files $this $objdir [lrange $tolink 1 end]]
555 set o_cons [console::embed \
557 [mc "Cloning from %s" $origin_url]]
558 pack $w_body -fill both -expand 1 -padx 10
560 [list git fetch --no-tags -k $origin_name] \
564 set fd [open [gitdir objects info alternates] w]
565 fconfigure $fd -translation binary
571 if {$clone_type eq {hardlink} || $clone_type eq {shared}} {
572 if {![_clone_refs $this]} return
576 set HEAD [git rev-parse --verify HEAD^0]
578 _clone_failed $this [mc "Not a Git repository: %s" [file tail $origin_url]]
582 _do_clone_checkout $this $HEAD
586 method _copy_files {objdir tocopy} {
588 [mc "Copying objects"] \
593 incr tot [file size [file join $objdir $p]]
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
602 while {![eof $f_in]} {
603 incr cmp [fcopy $f_in $f_cp -size 16384]
605 [expr {$cmp / 1024}] \
613 _clone_failed $this [mc "Unable to copy object: %s" $err]
620 method _link_files {objdir tolink} {
621 set total [llength $tolink]
623 [mc "Linking objects"] \
625 for {set i 0} {$i < $total} {} {
626 set p [lindex $tolink $i]
629 [file join .git objects $p] \
630 [file join $objdir $p]
632 _clone_failed $this [mc "Unable to hardlink object: %s" $err]
638 $o_cons update $i $total
645 method _clone_refs {} {
647 if {[catch {cd $origin_url} err]} {
648 error_popup [mc "Not a Git repository: %s" [file tail $origin_url]]
651 set fd_in [git_read for-each-ref \
653 {--format=list %(refname) %(objectname) %(*objectname)}]
656 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]
665 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"
680 method _do_clone_tags {ok} {
683 [list git fetch --tags -k $origin_name] \
687 _clone_failed $this [mc "Cannot fetch branches and objects. See console output for details."]
691 method _do_clone_HEAD {ok} {
694 [list git fetch $origin_name HEAD] \
695 [cb _do_clone_full_end]
698 _clone_failed $this [mc "Cannot fetch tags. See console output for details."]
702 method _do_clone_full_end {ok} {
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]} {
719 catch {git pack-refs}
720 _do_clone_checkout $this $HEAD
722 _clone_failed $this [mc "Cannot determine HEAD. See console output for details."]
726 method _clone_failed {{why {}}} {
727 if {[catch {file delete -force $local_path} err]} {
731 [mc "Unable to cleanup %s" $local_path] \
737 error_popup [strcat [mc "Clone failed."] "\n" $why]
741 method _do_clone_checkout {HEAD} {
744 [mc "No default branch obtained."] \
746 [mc "The 'master' branch has not been initialized."] \
752 git update-ref HEAD $HEAD^0
755 [mc "Cannot resolve %s as a commit." $HEAD^0] \
758 [mc "The 'master' branch has not been initialized."] \
764 set o_cons [status_bar::new $w_body]
765 pack $w_body -fill x -padx 10
767 [mc "Creating working directory"] \
771 set fd [git_read --stderr read-tree \
778 fconfigure $fd -blocking 0 -translation binary
779 fileevent $fd readable [cb _readtree_wait $fd]
782 method _readtree_wait {fd} {
784 $o_cons update_meter $buf
785 append readtree_err $buf
787 fconfigure $fd -blocking 1
789 fconfigure $fd -blocking 0
793 if {[catch {close $fd}]} {
794 set err $readtree_err
795 regsub {^fatal: } $err {} err
796 error_popup [strcat \
797 [mc "Initial file checkout failed."] \
805 ######################################################################
807 ## Open Existing Repository
812 -command [cb _do_open2] \
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
823 label $w_body.where.l -text [mc "Repository:"]
824 entry $w_body.where.t \
825 -textvariable @local_path \
828 button $w_body.where.b \
829 -text [mc "Browse"] \
830 -command [cb _open_local_path]
832 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
837 trace add variable @local_path write [cb _write_local_path]
839 focus $w_body.where.t
842 method _open_local_path {} {
843 if {$local_path ne {}} {
849 set p [tk_chooseDirectory \
852 -title [mc "Git Repository"] \
856 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]]
864 method _do_open2 {} {
865 if {![_is_git [file join $local_path .git]]} {
866 error_popup [mc "Not a Git repository: %s" [file tail $local_path]]
870 if {[catch {cd $local_path} err]} {
871 error_popup [strcat \
872 [mc "Failed to open repository %s:" $local_path] \