diff options
Diffstat (limited to 'third_party/git/git-gui/lib/choose_repository.tcl')
| -rw-r--r-- | third_party/git/git-gui/lib/choose_repository.tcl | 1132 |
1 files changed, 0 insertions, 1132 deletions
diff --git a/third_party/git/git-gui/lib/choose_repository.tcl b/third_party/git/git-gui/lib/choose_repository.tcl deleted file mode 100644 index 80f5a59bbb..0000000000 --- a/third_party/git/git-gui/lib/choose_repository.tcl +++ /dev/null @@ -1,1132 +0,0 @@ -# git-gui Git repository chooser -# Copyright (C) 2007 Shawn Pearce - -class choose_repository { - -field top -field w -field w_body ; # Widget holding the center content -field w_next ; # Next button -field w_quit ; # Quit button -field o_cons ; # Console object (if active) -field w_types ; # List of type buttons in clone -field w_recentlist ; # Listbox containing recent repositories -field w_localpath ; # Entry widget bound to local_path - -field done 0 ; # Finished picking the repository? -field local_path {} ; # Where this repository is locally -field origin_url {} ; # Where we are cloning from -field origin_name origin ; # What we shall call 'origin' -field clone_type hardlink ; # Type of clone to construct -field recursive true ; # Recursive cloning flag -field readtree_err ; # Error output from read-tree (if any) -field sorted_recent ; # recent repositories (sorted) - -constructor pick {} { - global M1T M1B use_ttk NS - - if {[set maxrecent [get_config gui.maxrecentrepo]] eq {}} { - set maxrecent 10 - } - - make_dialog top w - wm title $top [mc "Git Gui"] - - if {$top eq {.}} { - menu $w.mbar -tearoff 0 - $top configure -menu $w.mbar - - set m_repo $w.mbar.repository - $w.mbar add cascade \ - -label [mc Repository] \ - -menu $m_repo - menu $m_repo - - if {[is_MacOSX]} { - $w.mbar add cascade -label Apple -menu .mbar.apple - menu $w.mbar.apple - $w.mbar.apple add command \ - -label [mc "About %s" [appname]] \ - -command do_about - $w.mbar.apple add command \ - -label [mc "Show SSH Key"] \ - -command do_ssh_key - } else { - $w.mbar add cascade -label [mc Help] -menu $w.mbar.help - menu $w.mbar.help - $w.mbar.help add command \ - -label [mc "About %s" [appname]] \ - -command do_about - $w.mbar.help add command \ - -label [mc "Show SSH Key"] \ - -command do_ssh_key - } - - wm protocol $top WM_DELETE_WINDOW exit - bind $top <$M1B-q> exit - bind $top <$M1B-Q> exit - bind $top <Key-Escape> exit - } else { - wm geometry $top "+[winfo rootx .]+[winfo rooty .]" - bind $top <Key-Escape> [list destroy $top] - set m_repo {} - } - - pack [git_logo $w.git_logo] -side left -fill y -padx 10 -pady 10 - - set w_body $w.body - set opts $w_body.options - ${NS}::frame $w_body - text $opts \ - -cursor $::cursor_ptr \ - -relief flat \ - -background [get_bg_color $w_body] \ - -wrap none \ - -spacing1 5 \ - -width 50 \ - -height 3 - pack $opts -anchor w -fill x - - $opts tag conf link_new -foreground blue -underline 1 - $opts tag bind link_new <1> [cb _next new] - $opts insert end [mc "Create New Repository"] link_new - $opts insert end "\n" - if {$m_repo ne {}} { - $m_repo add command \ - -command [cb _next new] \ - -accelerator $M1T-N \ - -label [mc "New..."] - bind $top <$M1B-n> [cb _next new] - bind $top <$M1B-N> [cb _next new] - } - - $opts tag conf link_clone -foreground blue -underline 1 - $opts tag bind link_clone <1> [cb _next clone] - $opts insert end [mc "Clone Existing Repository"] link_clone - $opts insert end "\n" - if {$m_repo ne {}} { - if {[tk windowingsystem] eq "win32"} { - set key L - } else { - set key C - } - $m_repo add command \ - -command [cb _next clone] \ - -accelerator $M1T-$key \ - -label [mc "Clone..."] - bind $top <$M1B-[string tolower $key]> [cb _next clone] - bind $top <$M1B-[string toupper $key]> [cb _next clone] - } - - $opts tag conf link_open -foreground blue -underline 1 - $opts tag bind link_open <1> [cb _next open] - $opts insert end [mc "Open Existing Repository"] link_open - $opts insert end "\n" - if {$m_repo ne {}} { - $m_repo add command \ - -command [cb _next open] \ - -accelerator $M1T-O \ - -label [mc "Open..."] - bind $top <$M1B-o> [cb _next open] - bind $top <$M1B-O> [cb _next open] - } - - $opts conf -state disabled - - set sorted_recent [_get_recentrepos] - if {[llength $sorted_recent] > 0} { - if {$m_repo ne {}} { - $m_repo add separator - $m_repo add command \ - -state disabled \ - -label [mc "Recent Repositories"] - } - - if {[set lenrecent [llength $sorted_recent]] < $maxrecent} { - set lenrecent $maxrecent - } - - ${NS}::label $w_body.space - ${NS}::label $w_body.recentlabel \ - -anchor w \ - -text [mc "Open Recent Repository:"] - set w_recentlist $w_body.recentlist - text $w_recentlist \ - -cursor $::cursor_ptr \ - -relief flat \ - -background [get_bg_color $w_body.recentlabel] \ - -wrap none \ - -width 50 \ - -height $lenrecent - $w_recentlist tag conf link \ - -foreground blue \ - -underline 1 - set home $::env(HOME) - if {[is_Cygwin]} { - set home [exec cygpath --windows --absolute $home] - } - set home "[file normalize $home]/" - set hlen [string length $home] - foreach p $sorted_recent { - set path $p - if {[string equal -length $hlen $home $p]} { - set p "~/[string range $p $hlen end]" - } - regsub -all "\n" $p "\\n" p - $w_recentlist insert end $p link - $w_recentlist insert end "\n" - - if {$m_repo ne {}} { - $m_repo add command \ - -command [cb _open_recent_path $path] \ - -label " $p" - } - } - $w_recentlist conf -state disabled - $w_recentlist tag bind link <1> [cb _open_recent %x,%y] - pack $w_body.space -anchor w -fill x - pack $w_body.recentlabel -anchor w -fill x - pack $w_recentlist -anchor w -fill x - } - pack $w_body -fill x -padx 10 -pady 10 - - ${NS}::frame $w.buttons - set w_next $w.buttons.next - set w_quit $w.buttons.quit - ${NS}::button $w_quit \ - -text [mc "Quit"] \ - -command exit - pack $w_quit -side right -padx 5 - pack $w.buttons -side bottom -fill x -padx 10 -pady 10 - - if {$m_repo ne {}} { - $m_repo add separator - $m_repo add command \ - -label [mc Quit] \ - -command exit \ - -accelerator $M1T-Q - } - - bind $top <Return> [cb _invoke_next] - bind $top <Visibility> " - [cb _center] - grab $top - focus $top - bind $top <Visibility> {} - " - wm deiconify $top - tkwait variable @done - - grab release $top - if {$top eq {.}} { - eval destroy [winfo children $top] - } -} - -method _center {} { - set nx [winfo reqwidth $top] - set ny [winfo reqheight $top] - set rx [expr {([winfo screenwidth $top] - $nx) / 3}] - set ry [expr {([winfo screenheight $top] - $ny) / 3}] - wm geometry $top [format {+%d+%d} $rx $ry] -} - -method _invoke_next {} { - if {[winfo exists $w_next]} { - uplevel #0 [$w_next cget -command] - } -} - -proc _get_recentrepos {} { - set recent [list] - foreach p [lsort -unique [get_config gui.recentrepo]] { - if {[_is_git [file join $p .git]]} { - lappend recent $p - } else { - _unset_recentrepo $p - } - } - return $recent -} - -proc _unset_recentrepo {p} { - regsub -all -- {([()\[\]{}\.^$+*?\\])} $p {\\\1} p - catch {git config --global --unset-all gui.recentrepo "^$p\$"} - load_config 1 -} - -proc _append_recentrepos {path} { - set path [file normalize $path] - set recent [get_config gui.recentrepo] - - if {[lindex $recent end] eq $path} { - return - } - - set i [lsearch $recent $path] - if {$i >= 0} { - _unset_recentrepo $path - } - - git config --global --add gui.recentrepo $path - load_config 1 - set recent [get_config gui.recentrepo] - - if {[set maxrecent [get_config gui.maxrecentrepo]] eq {}} { - set maxrecent 10 - } - - while {[llength $recent] > $maxrecent} { - _unset_recentrepo [lindex $recent 0] - set recent [get_config gui.recentrepo] - } -} - -method _open_recent {xy} { - set id [lindex [split [$w_recentlist index @$xy] .] 0] - set local_path [lindex $sorted_recent [expr {$id - 1}]] - _do_open2 $this -} - -method _open_recent_path {p} { - set local_path $p - _do_open2 $this -} - -method _next {action} { - global NS - destroy $w_body - if {![winfo exists $w_next]} { - ${NS}::button $w_next -default active - set pos -before - if {[tk windowingsystem] eq "win32"} { set pos -after } - pack $w_next -side right -padx 5 $pos $w_quit - } - _do_$action $this -} - -method _write_local_path {args} { - if {$local_path eq {}} { - $w_next conf -state disabled - } else { - $w_next conf -state normal - } -} - -method _git_init {} { - if {[catch {file mkdir $local_path} err]} { - error_popup [strcat \ - [mc "Failed to create repository %s:" $local_path] \ - "\n\n$err"] - return 0 - } - - if {[catch {cd $local_path} err]} { - error_popup [strcat \ - [mc "Failed to create repository %s:" $local_path] \ - "\n\n$err"] - return 0 - } - - if {[catch {git init} err]} { - error_popup [strcat \ - [mc "Failed to create repository %s:" $local_path] \ - "\n\n$err"] - return 0 - } - - _append_recentrepos [pwd] - set ::_gitdir .git - set ::_prefix {} - return 1 -} - -proc _is_git {path {outdir_var ""}} { - if {$outdir_var ne ""} { - upvar 1 $outdir_var outdir - } - if {[file isfile $path]} { - set fp [open $path r] - gets $fp line - close $fp - if {[regexp "^gitdir: (.+)$" $line line link_target]} { - set path [file join [file dirname $path] $link_target] - set path [file normalize $path] - } - } - - if {[file exists [file join $path HEAD]] - && [file exists [file join $path objects]] - && [file exists [file join $path config]]} { - set outdir $path - return 1 - } - if {[is_Cygwin]} { - if {[file exists [file join $path HEAD]] - && [file exists [file join $path objects.lnk]] - && [file exists [file join $path config.lnk]]} { - set outdir $path - return 1 - } - } - return 0 -} - -proc _objdir {path} { - set objdir [file join $path .git objects] - if {[file isdirectory $objdir]} { - return $objdir - } - - set objdir [file join $path objects] - if {[file isdirectory $objdir]} { - return $objdir - } - - if {[is_Cygwin]} { - set objdir [file join $path .git objects.lnk] - if {[file isfile $objdir]} { - return [win32_read_lnk $objdir] - } - - set objdir [file join $path objects.lnk] - if {[file isfile $objdir]} { - return [win32_read_lnk $objdir] - } - } - - return {} -} - -###################################################################### -## -## Create New Repository - -method _do_new {} { - global use_ttk NS - $w_next conf \ - -state disabled \ - -command [cb _do_new2] \ - -text [mc "Create"] - - ${NS}::frame $w_body - ${NS}::label $w_body.h \ - -font font_uibold -anchor center \ - -text [mc "Create New Repository"] - pack $w_body.h -side top -fill x -pady 10 - pack $w_body -fill x -padx 10 - - ${NS}::frame $w_body.where - ${NS}::label $w_body.where.l -text [mc "Directory:"] - ${NS}::entry $w_body.where.t \ - -textvariable @local_path \ - -width 50 - ${NS}::button $w_body.where.b \ - -text [mc "Browse"] \ - -command [cb _new_local_path] - set w_localpath $w_body.where.t - - grid $w_body.where.l $w_body.where.t $w_body.where.b -sticky ew - pack $w_body.where -fill x - - grid columnconfigure $w_body.where 1 -weight 1 - - trace add variable @local_path write [cb _write_local_path] - bind $w_body.h <Destroy> [list trace remove variable @local_path write [cb _write_local_path]] - update - focus $w_body.where.t -} - -method _new_local_path {} { - if {$local_path ne {}} { - set p [file dirname $local_path] - } else { - set p [pwd] - } - - set p [tk_chooseDirectory \ - -initialdir $p \ - -parent $top \ - -title [mc "Git Repository"] \ - -mustexist false] - if {$p eq {}} return - - set p [file normalize $p] - if {![_new_ok $p]} { - return - } - set local_path $p - $w_localpath icursor end -} - -method _do_new2 {} { - if {![_new_ok $local_path]} { - return - } - if {![_git_init $this]} { - return - } - set done 1 -} - -proc _new_ok {p} { - if {[file isdirectory $p]} { - if {[_is_git [file join $p .git]]} { - error_popup [mc "Directory %s already exists." $p] - return 0 - } - } elseif {[file exists $p]} { - error_popup [mc "File %s already exists." $p] - return 0 - } - return 1 -} - -###################################################################### -## -## Clone Existing Repository - -method _do_clone {} { - global use_ttk NS - $w_next conf \ - -state disabled \ - -command [cb _do_clone2] \ - -text [mc "Clone"] - - ${NS}::frame $w_body - ${NS}::label $w_body.h \ - -font font_uibold -anchor center \ - -text [mc "Clone Existing Repository"] - pack $w_body.h -side top -fill x -pady 10 - pack $w_body -fill x -padx 10 - - set args $w_body.args - ${NS}::frame $w_body.args - pack $args -fill both - - ${NS}::label $args.origin_l -text [mc "Source Location:"] - ${NS}::entry $args.origin_t \ - -textvariable @origin_url \ - -width 50 - ${NS}::button $args.origin_b \ - -text [mc "Browse"] \ - -command [cb _open_origin] - grid $args.origin_l $args.origin_t $args.origin_b -sticky ew - - ${NS}::label $args.where_l -text [mc "Target Directory:"] - ${NS}::entry $args.where_t \ - -textvariable @local_path \ - -width 50 - ${NS}::button $args.where_b \ - -text [mc "Browse"] \ - -command [cb _new_local_path] - grid $args.where_l $args.where_t $args.where_b -sticky ew - set w_localpath $args.where_t - - ${NS}::label $args.type_l -text [mc "Clone Type:"] - ${NS}::frame $args.type_f - set w_types [list] - lappend w_types [${NS}::radiobutton $args.type_f.hardlink \ - -state disabled \ - -text [mc "Standard (Fast, Semi-Redundant, Hardlinks)"] \ - -variable @clone_type \ - -value hardlink] - lappend w_types [${NS}::radiobutton $args.type_f.full \ - -state disabled \ - -text [mc "Full Copy (Slower, Redundant Backup)"] \ - -variable @clone_type \ - -value full] - lappend w_types [${NS}::radiobutton $args.type_f.shared \ - -state disabled \ - -text [mc "Shared (Fastest, Not Recommended, No Backup)"] \ - -variable @clone_type \ - -value shared] - foreach r $w_types { - pack $r -anchor w - } - ${NS}::checkbutton $args.type_f.recursive \ - -text [mc "Recursively clone submodules too"] \ - -variable @recursive \ - -onvalue true -offvalue false - pack $args.type_f.recursive -anchor w - grid $args.type_l $args.type_f -sticky new - - grid columnconfigure $args 1 -weight 1 - - trace add variable @local_path write [cb _update_clone] - trace add variable @origin_url write [cb _update_clone] - bind $w_body.h <Destroy> " - [list trace remove variable @local_path write [cb _update_clone]] - [list trace remove variable @origin_url write [cb _update_clone]] - " - update - focus $args.origin_t -} - -method _open_origin {} { - if {$origin_url ne {} && [file isdirectory $origin_url]} { - set p $origin_url - } else { - set p [pwd] - } - - set p [tk_chooseDirectory \ - -initialdir $p \ - -parent $top \ - -title [mc "Git Repository"] \ - -mustexist true] - if {$p eq {}} return - - set p [file normalize $p] - if {![_is_git [file join $p .git]] && ![_is_git $p]} { - error_popup [mc "Not a Git repository: %s" [file tail $p]] - return - } - set origin_url $p -} - -method _update_clone {args} { - if {$local_path ne {} && $origin_url ne {}} { - $w_next conf -state normal - } else { - $w_next conf -state disabled - } - - if {$origin_url ne {} && - ( [_is_git [file join $origin_url .git]] - || [_is_git $origin_url])} { - set e normal - if {[[lindex $w_types 0] cget -state] eq {disabled}} { - set clone_type hardlink - } - } else { - set e disabled - set clone_type full - } - - foreach r $w_types { - $r conf -state $e - } -} - -method _do_clone2 {} { - if {[file isdirectory $origin_url]} { - set origin_url [file normalize $origin_url] - } - - if {$clone_type eq {hardlink} && ![file isdirectory $origin_url]} { - error_popup [mc "Standard only available for local repository."] - return - } - if {$clone_type eq {shared} && ![file isdirectory $origin_url]} { - error_popup [mc "Shared only available for local repository."] - return - } - - if {$clone_type eq {hardlink} || $clone_type eq {shared}} { - set objdir [_objdir $origin_url] - if {$objdir eq {}} { - error_popup [mc "Not a Git repository: %s" [file tail $origin_url]] - return - } - } - - set giturl $origin_url - if {[is_Cygwin] && [file isdirectory $giturl]} { - set giturl [exec cygpath --unix --absolute $giturl] - if {$clone_type eq {shared}} { - set objdir [exec cygpath --unix --absolute $objdir] - } - } - - if {[file exists $local_path]} { - error_popup [mc "Location %s already exists." $local_path] - return - } - - if {![_git_init $this]} return - set local_path [pwd] - - if {[catch { - git config remote.$origin_name.url $giturl - git config remote.$origin_name.fetch +refs/heads/*:refs/remotes/$origin_name/* - } err]} { - error_popup [strcat [mc "Failed to configure origin"] "\n\n$err"] - return - } - - destroy $w_body $w_next - - switch -exact -- $clone_type { - hardlink { - set o_cons [status_bar::two_line $w_body] - pack $w_body -fill x -padx 10 -pady 10 - - $o_cons start \ - [mc "Counting objects"] \ - [mc "buckets"] - update - - if {[file exists [file join $objdir info alternates]]} { - set pwd [pwd] - if {[catch { - file mkdir [gitdir objects info] - set f_in [open [file join $objdir info alternates] r] - set f_cp [open [gitdir objects info alternates] w] - fconfigure $f_in -translation binary -encoding binary - fconfigure $f_cp -translation binary -encoding binary - cd $objdir - while {[gets $f_in line] >= 0} { - if {[is_Cygwin]} { - puts $f_cp [exec cygpath --unix --absolute $line] - } else { - puts $f_cp [file normalize $line] - } - } - close $f_in - close $f_cp - cd $pwd - } err]} { - catch {cd $pwd} - _clone_failed $this [mc "Unable to copy objects/info/alternates: %s" $err] - return - } - } - - set tolink [list] - set buckets [glob \ - -tails \ - -nocomplain \ - -directory [file join $objdir] ??] - set bcnt [expr {[llength $buckets] + 2}] - set bcur 1 - $o_cons update $bcur $bcnt - update - - file mkdir [file join .git objects pack] - foreach i [glob -tails -nocomplain \ - -directory [file join $objdir pack] *] { - lappend tolink [file join pack $i] - } - $o_cons update [incr bcur] $bcnt - update - - foreach i $buckets { - file mkdir [file join .git objects $i] - foreach j [glob -tails -nocomplain \ - -directory [file join $objdir $i] *] { - lappend tolink [file join $i $j] - } - $o_cons update [incr bcur] $bcnt - update - } - $o_cons stop - - if {$tolink eq {}} { - info_popup [strcat \ - [mc "Nothing to clone from %s." $origin_url] \ - "\n" \ - [mc "The 'master' branch has not been initialized."] \ - ] - destroy $w_body - set done 1 - return - } - - set i [lindex $tolink 0] - if {[catch { - file link -hard \ - [file join .git objects $i] \ - [file join $objdir $i] - } err]} { - info_popup [mc "Hardlinks are unavailable. Falling back to copying."] - set i [_copy_files $this $objdir $tolink] - } else { - set i [_link_files $this $objdir [lrange $tolink 1 end]] - } - if {!$i} return - - destroy $w_body - } - full { - set o_cons [console::embed \ - $w_body \ - [mc "Cloning from %s" $origin_url]] - pack $w_body -fill both -expand 1 -padx 10 - $o_cons exec \ - [list git fetch --no-tags -k $origin_name] \ - [cb _do_clone_tags] - } - shared { - set fd [open [gitdir objects info alternates] w] - fconfigure $fd -translation binary - puts $fd $objdir - close $fd - } - } - - if {$clone_type eq {hardlink} || $clone_type eq {shared}} { - if {![_clone_refs $this]} return - set pwd [pwd] - if {[catch { - cd $origin_url - set HEAD [git rev-parse --verify HEAD^0] - } err]} { - _clone_failed $this [mc "Not a Git repository: %s" [file tail $origin_url]] - return 0 - } - cd $pwd - _do_clone_checkout $this $HEAD - } -} - -method _copy_files {objdir tocopy} { - $o_cons start \ - [mc "Copying objects"] \ - [mc "KiB"] - set tot 0 - set cmp 0 - foreach p $tocopy { - incr tot [file size [file join $objdir $p]] - } - foreach p $tocopy { - if {[catch { - set f_in [open [file join $objdir $p] r] - set f_cp [open [file join .git objects $p] w] - fconfigure $f_in -translation binary -encoding binary - fconfigure $f_cp -translation binary -encoding binary - - while {![eof $f_in]} { - incr cmp [fcopy $f_in $f_cp -size 16384] - $o_cons update \ - [expr {$cmp / 1024}] \ - [expr {$tot / 1024}] - update - } - - close $f_in - close $f_cp - } err]} { - _clone_failed $this [mc "Unable to copy object: %s" $err] - return 0 - } - } - return 1 -} - -method _link_files {objdir tolink} { - set total [llength $tolink] - $o_cons start \ - [mc "Linking objects"] \ - [mc "objects"] - for {set i 0} {$i < $total} {} { - set p [lindex $tolink $i] - if {[catch { - file link -hard \ - [file join .git objects $p] \ - [file join $objdir $p] - } err]} { - _clone_failed $this [mc "Unable to hardlink object: %s" $err] - return 0 - } - - incr i - if {$i % 5 == 0} { - $o_cons update $i $total - update - } - } - return 1 -} - -method _clone_refs {} { - set pwd [pwd] - if {[catch {cd $origin_url} err]} { - error_popup [mc "Not a Git repository: %s" [file tail $origin_url]] - return 0 - } - set fd_in [git_read for-each-ref \ - --tcl \ - {--format=list %(refname) %(objectname) %(*objectname)}] - cd $pwd - - set fd [open [gitdir packed-refs] w] - fconfigure $fd -translation binary - puts $fd "# pack-refs with: peeled" - while {[gets $fd_in line] >= 0} { - set line [eval $line] - set refn [lindex $line 0] - set robj [lindex $line 1] - set tobj [lindex $line 2] - - if {[regsub ^refs/heads/ $refn \ - "refs/remotes/$origin_name/" refn]} { - puts $fd "$robj $refn" - } elseif {[string match refs/tags/* $refn]} { - puts $fd "$robj $refn" - if {$tobj ne {}} { - puts $fd "^$tobj" - } - } - } - close $fd_in - close $fd - return 1 -} - -method _do_clone_tags {ok} { - if {$ok} { - $o_cons exec \ - [list git fetch --tags -k $origin_name] \ - [cb _do_clone_HEAD] - } else { - $o_cons done $ok - _clone_failed $this [mc "Cannot fetch branches and objects. See console output for details."] - } -} - -method _do_clone_HEAD {ok} { - if {$ok} { - $o_cons exec \ - [list git fetch $origin_name HEAD] \ - [cb _do_clone_full_end] - } else { - $o_cons done $ok - _clone_failed $this [mc "Cannot fetch tags. See console output for details."] - } -} - -method _do_clone_full_end {ok} { - $o_cons done $ok - - if {$ok} { - destroy $w_body - - set HEAD {} - if {[file exists [gitdir FETCH_HEAD]]} { - set fd [open [gitdir FETCH_HEAD] r] - while {[gets $fd line] >= 0} { - if {[regexp "^(.{40})\t\t" $line line HEAD]} { - break - } - } - close $fd - } - - catch {git pack-refs} - _do_clone_checkout $this $HEAD - } else { - _clone_failed $this [mc "Cannot determine HEAD. See console output for details."] - } -} - -method _clone_failed {{why {}}} { - if {[catch {file delete -force $local_path} err]} { - set why [strcat \ - $why \ - "\n\n" \ - [mc "Unable to cleanup %s" $local_path] \ - "\n\n" \ - $err] - } - if {$why ne {}} { - update - error_popup [strcat [mc "Clone failed."] "\n" $why] - } -} - -method _do_clone_checkout {HEAD} { - if {$HEAD eq {}} { - info_popup [strcat \ - [mc "No default branch obtained."] \ - "\n" \ - [mc "The 'master' branch has not been initialized."] \ - ] - set done 1 - return - } - if {[catch { - git update-ref HEAD $HEAD^0 - } err]} { - info_popup [strcat \ - [mc "Cannot resolve %s as a commit." $HEAD^0] \ - "\n $err" \ - "\n" \ - [mc "The 'master' branch has not been initialized."] \ - ] - set done 1 - return - } - - set o_cons [status_bar::two_line $w_body] - pack $w_body -fill x -padx 10 -pady 10 - $o_cons start \ - [mc "Creating working directory"] \ - [mc "files"] - - set readtree_err {} - set fd [git_read --stderr read-tree \ - -m \ - -u \ - -v \ - HEAD \ - HEAD \ - ] - fconfigure $fd -blocking 0 -translation binary - fileevent $fd readable [cb _readtree_wait $fd] -} - -method _do_validate_submodule_cloning {ok} { - if {$ok} { - $o_cons done $ok - set done 1 - } else { - _clone_failed $this [mc "Cannot clone submodules."] - } -} - -method _do_clone_submodules {} { - if {$recursive eq {true}} { - destroy $w_body - set o_cons [console::embed \ - $w_body \ - [mc "Cloning submodules"]] - pack $w_body -fill both -expand 1 -padx 10 - $o_cons exec \ - [list git submodule update --init --recursive] \ - [cb _do_validate_submodule_cloning] - } else { - set done 1 - } -} - -method _readtree_wait {fd} { - set buf [read $fd] - $o_cons update_meter $buf - append readtree_err $buf - - fconfigure $fd -blocking 1 - if {![eof $fd]} { - fconfigure $fd -blocking 0 - return - } - - if {[catch {close $fd}]} { - set err $readtree_err - regsub {^fatal: } $err {} err - error_popup [strcat \ - [mc "Initial file checkout failed."] \ - "\n\n$err"] - return - } - - # -- Run the post-checkout hook. - # - set fd_ph [githook_read post-checkout [string repeat 0 40] \ - [git rev-parse HEAD] 1] - if {$fd_ph ne {}} { - global pch_error - set pch_error {} - fconfigure $fd_ph -blocking 0 -translation binary -eofchar {} - fileevent $fd_ph readable [cb _postcheckout_wait $fd_ph] - } else { - _do_clone_submodules $this - } -} - -method _postcheckout_wait {fd_ph} { - global pch_error - - append pch_error [read $fd_ph] - fconfigure $fd_ph -blocking 1 - if {[eof $fd_ph]} { - if {[catch {close $fd_ph}]} { - hook_failed_popup post-checkout $pch_error 0 - } - unset pch_error - _do_clone_submodules $this - return - } - fconfigure $fd_ph -blocking 0 -} - -###################################################################### -## -## Open Existing Repository - -method _do_open {} { - global NS - $w_next conf \ - -state disabled \ - -command [cb _do_open2] \ - -text [mc "Open"] - - ${NS}::frame $w_body - ${NS}::label $w_body.h \ - -font font_uibold -anchor center \ - -text [mc "Open Existing Repository"] - pack $w_body.h -side top -fill x -pady 10 - pack $w_body -fill x -padx 10 - - ${NS}::frame $w_body.where - ${NS}::label $w_body.where.l -text [mc "Repository:"] - ${NS}::entry $w_body.where.t \ - -textvariable @local_path \ - -width 50 - ${NS}::button $w_body.where.b \ - -text [mc "Browse"] \ - -command [cb _open_local_path] - - grid $w_body.where.l $w_body.where.t $w_body.where.b -sticky ew - pack $w_body.where -fill x - - grid columnconfigure $w_body.where 1 -weight 1 - - trace add variable @local_path write [cb _write_local_path] - bind $w_body.h <Destroy> [list trace remove variable @local_path write [cb _write_local_path]] - update - focus $w_body.where.t -} - -method _open_local_path {} { - if {$local_path ne {}} { - set p $local_path - } else { - set p [pwd] - } - - set p [tk_chooseDirectory \ - -initialdir $p \ - -parent $top \ - -title [mc "Git Repository"] \ - -mustexist true] - if {$p eq {}} return - - set p [file normalize $p] - if {![_is_git [file join $p .git]]} { - error_popup [mc "Not a Git repository: %s" [file tail $p]] - return - } - set local_path $p -} - -method _do_open2 {} { - if {![_is_git [file join $local_path .git] actualgit]} { - error_popup [mc "Not a Git repository: %s" [file tail $local_path]] - return - } - - if {[catch {cd $local_path} err]} { - error_popup [strcat \ - [mc "Failed to open repository %s:" $local_path] \ - "\n\n$err"] - return - } - - _append_recentrepos [pwd] - set ::_gitdir $actualgit - set ::_prefix {} - set done 1 -} - -} |