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