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 {[catch {set outdir [git rev-parse --resolve-git-dir $path]}]} { 361 return 0 362 } 363 return 1 364} 365 366proc _objdir {path} { 367 set objdir [file join $path .git objects] 368 if {[file isdirectory $objdir]} { 369 return $objdir 370 } 371 372 set objdir [file join $path objects] 373 if {[file isdirectory $objdir]} { 374 return $objdir 375 } 376 377 if {[is_Cygwin]} { 378 set objdir [file join $path .git objects.lnk] 379 if {[file isfile $objdir]} { 380 return [win32_read_lnk $objdir] 381 } 382 383 set objdir [file join $path objects.lnk] 384 if {[file isfile $objdir]} { 385 return [win32_read_lnk $objdir] 386 } 387 } 388 389 return {} 390} 391 392###################################################################### 393## 394## Create New Repository 395 396method _do_new {} { 397 global use_ttk NS 398 $w_next conf \ 399 -state disabled \ 400 -command [cb _do_new2] \ 401 -text [mc "Create"] 402 403 ${NS}::frame $w_body 404 ${NS}::label $w_body.h \ 405 -font font_uibold -anchor center \ 406 -text [mc "Create New Repository"] 407 pack $w_body.h -side top -fill x -pady 10 408 pack $w_body -fill x -padx 10 409 410 ${NS}::frame $w_body.where 411 ${NS}::label $w_body.where.l -text [mc "Directory:"] 412 ${NS}::entry $w_body.where.t \ 413 -textvariable @local_path \ 414 -width 50 415 ${NS}::button $w_body.where.b \ 416 -text [mc "Browse"] \ 417 -command [cb _new_local_path] 418 set w_localpath $w_body.where.t 419 420 grid $w_body.where.l $w_body.where.t $w_body.where.b -sticky ew 421 pack $w_body.where -fill x 422 423 grid columnconfigure $w_body.where 1 -weight 1 424 425 trace add variable @local_path write [cb _write_local_path] 426 bind $w_body.h <Destroy> [list trace remove variable @local_path write [cb _write_local_path]] 427 update 428 focus $w_body.where.t 429} 430 431method _new_local_path {} { 432 if {$local_path ne {}} { 433 set p [file dirname $local_path] 434 } else { 435 set p [pwd] 436 } 437 438 set p [tk_chooseDirectory \ 439 -initialdir $p \ 440 -parent $top \ 441 -title [mc "Git Repository"] \ 442 -mustexist false] 443 if {$p eq {}} return 444 445 set p [file normalize $p] 446 if {![_new_ok $p]} { 447 return 448 } 449 set local_path $p 450 $w_localpath icursor end 451} 452 453method _do_new2 {} { 454 if {![_new_ok $local_path]} { 455 return 456 } 457 if {![_git_init $this]} { 458 return 459 } 460 set done 1 461} 462 463proc _new_ok {p} { 464 if {[file isdirectory $p]} { 465 if {[_is_git [file join $p .git]]} { 466 error_popup [mc "Directory %s already exists." $p] 467 return 0 468 } 469 } elseif {[file exists $p]} { 470 error_popup [mc "File %s already exists." $p] 471 return 0 472 } 473 return 1 474} 475 476###################################################################### 477## 478## Clone Existing Repository 479 480method _do_clone {} { 481 global use_ttk NS 482 $w_next conf \ 483 -state disabled \ 484 -command [cb _do_clone2] \ 485 -text [mc "Clone"] 486 487 ${NS}::frame $w_body 488 ${NS}::label $w_body.h \ 489 -font font_uibold -anchor center \ 490 -text [mc "Clone Existing Repository"] 491 pack $w_body.h -side top -fill x -pady 10 492 pack $w_body -fill x -padx 10 493 494 set args $w_body.args 495 ${NS}::frame $w_body.args 496 pack $args -fill both 497 498 ${NS}::label $args.origin_l -text [mc "Source Location:"] 499 ${NS}::entry $args.origin_t \ 500 -textvariable @origin_url \ 501 -width 50 502 ${NS}::button $args.origin_b \ 503 -text [mc "Browse"] \ 504 -command [cb _open_origin] 505 grid $args.origin_l $args.origin_t $args.origin_b -sticky ew 506 507 ${NS}::label $args.where_l -text [mc "Target Directory:"] 508 ${NS}::entry $args.where_t \ 509 -textvariable @local_path \ 510 -width 50 511 ${NS}::button $args.where_b \ 512 -text [mc "Browse"] \ 513 -command [cb _new_local_path] 514 grid $args.where_l $args.where_t $args.where_b -sticky ew 515 set w_localpath $args.where_t 516 517 ${NS}::label $args.type_l -text [mc "Clone Type:"] 518 ${NS}::frame $args.type_f 519 set w_types [list] 520 lappend w_types [${NS}::radiobutton $args.type_f.hardlink \ 521 -state disabled \ 522 -text [mc "Standard (Fast, Semi-Redundant, Hardlinks)"] \ 523 -variable @clone_type \ 524 -value hardlink] 525 lappend w_types [${NS}::radiobutton $args.type_f.full \ 526 -state disabled \ 527 -text [mc "Full Copy (Slower, Redundant Backup)"] \ 528 -variable @clone_type \ 529 -value full] 530 lappend w_types [${NS}::radiobutton $args.type_f.shared \ 531 -state disabled \ 532 -text [mc "Shared (Fastest, Not Recommended, No Backup)"] \ 533 -variable @clone_type \ 534 -value shared] 535 foreach r $w_types { 536 pack $r -anchor w 537 } 538 ${NS}::checkbutton $args.type_f.recursive \ 539 -text [mc "Recursively clone submodules too"] \ 540 -variable @recursive \ 541 -onvalue true -offvalue false 542 pack $args.type_f.recursive -anchor w 543 grid $args.type_l $args.type_f -sticky new 544 545 grid columnconfigure $args 1 -weight 1 546 547 trace add variable @local_path write [cb _update_clone] 548 trace add variable @origin_url write [cb _update_clone] 549 bind $w_body.h <Destroy> " 550 [list trace remove variable @local_path write [cb _update_clone]] 551 [list trace remove variable @origin_url write [cb _update_clone]] 552 " 553 update 554 focus $args.origin_t 555} 556 557method _open_origin {} { 558 if {$origin_url ne {} && [file isdirectory $origin_url]} { 559 set p $origin_url 560 } else { 561 set p [pwd] 562 } 563 564 set p [tk_chooseDirectory \ 565 -initialdir $p \ 566 -parent $top \ 567 -title [mc "Git Repository"] \ 568 -mustexist true] 569 if {$p eq {}} return 570 571 set p [file normalize $p] 572 if {![_is_git [file join $p .git]] && ![_is_git $p]} { 573 error_popup [mc "Not a Git repository: %s" [file tail $p]] 574 return 575 } 576 set origin_url $p 577} 578 579method _update_clone {args} { 580 if {$local_path ne {} && $origin_url ne {}} { 581 $w_next conf -state normal 582 } else { 583 $w_next conf -state disabled 584 } 585 586 if {$origin_url ne {} && 587 ( [_is_git [file join $origin_url .git]] 588 || [_is_git $origin_url])} { 589 set e normal 590 if {[[lindex $w_types 0] cget -state] eq {disabled}} { 591 set clone_type hardlink 592 } 593 } else { 594 set e disabled 595 set clone_type full 596 } 597 598 foreach r $w_types { 599 $r conf -state $e 600 } 601} 602 603method _do_clone2 {} { 604 if {[file isdirectory $origin_url]} { 605 set origin_url [file normalize $origin_url] 606 } 607 608 if {$clone_type eq {hardlink} && ![file isdirectory $origin_url]} { 609 error_popup [mc "Standard only available for local repository."] 610 return 611 } 612 if {$clone_type eq {shared} && ![file isdirectory $origin_url]} { 613 error_popup [mc "Shared only available for local repository."] 614 return 615 } 616 617 if {$clone_type eq {hardlink} || $clone_type eq {shared}} { 618 set objdir [_objdir $origin_url] 619 if {$objdir eq {}} { 620 error_popup [mc "Not a Git repository: %s" [file tail $origin_url]] 621 return 622 } 623 } 624 625 set giturl $origin_url 626 if {[is_Cygwin] && [file isdirectory $giturl]} { 627 set giturl [exec cygpath --unix --absolute $giturl] 628 if {$clone_type eq {shared}} { 629 set objdir [exec cygpath --unix --absolute $objdir] 630 } 631 } 632 633 if {[file exists $local_path]} { 634 error_popup [mc "Location %s already exists." $local_path] 635 return 636 } 637 638 if {![_git_init $this]} return 639 set local_path [pwd] 640 641 if {[catch { 642 git config remote.$origin_name.url $giturl 643 git config remote.$origin_name.fetch +refs/heads/*:refs/remotes/$origin_name/* 644 } err]} { 645 error_popup [strcat [mc "Failed to configure origin"] "\n\n$err"] 646 return 647 } 648 649 destroy $w_body $w_next 650 651 switch -exact -- $clone_type { 652 hardlink { 653 set o_status [status_bar::two_line $w_body] 654 pack $w_body -fill x -padx 10 -pady 10 655 656 set status_op [$o_status start \ 657 [mc "Counting objects"] \ 658 [mc "buckets"]] 659 update 660 661 if {[file exists [file join $objdir info alternates]]} { 662 set pwd [pwd] 663 if {[catch { 664 file mkdir [gitdir objects info] 665 set f_in [open [file join $objdir info alternates] r] 666 set f_cp [open [gitdir objects info alternates] w] 667 fconfigure $f_in -translation binary -encoding binary 668 fconfigure $f_cp -translation binary -encoding binary 669 cd $objdir 670 while {[gets $f_in line] >= 0} { 671 if {[is_Cygwin]} { 672 puts $f_cp [exec cygpath --unix --absolute $line] 673 } else { 674 puts $f_cp [file normalize $line] 675 } 676 } 677 close $f_in 678 close $f_cp 679 cd $pwd 680 } err]} { 681 catch {cd $pwd} 682 _clone_failed $this [mc "Unable to copy objects/info/alternates: %s" $err] 683 $status_op stop 684 return 685 } 686 } 687 688 set tolink [list] 689 set buckets [glob \ 690 -tails \ 691 -nocomplain \ 692 -directory [file join $objdir] ??] 693 set bcnt [expr {[llength $buckets] + 2}] 694 set bcur 1 695 $status_op update $bcur $bcnt 696 update 697 698 file mkdir [file join .git objects pack] 699 foreach i [glob -tails -nocomplain \ 700 -directory [file join $objdir pack] *] { 701 lappend tolink [file join pack $i] 702 } 703 $status_op update [incr bcur] $bcnt 704 update 705 706 foreach i $buckets { 707 file mkdir [file join .git objects $i] 708 foreach j [glob -tails -nocomplain \ 709 -directory [file join $objdir $i] *] { 710 lappend tolink [file join $i $j] 711 } 712 $status_op update [incr bcur] $bcnt 713 update 714 } 715 $status_op stop 716 717 if {$tolink eq {}} { 718 info_popup [strcat \ 719 [mc "Nothing to clone from %s." $origin_url] \ 720 "\n" \ 721 [mc "The 'master' branch has not been initialized."] \ 722 ] 723 destroy $w_body 724 set done 1 725 return 726 } 727 728 set i [lindex $tolink 0] 729 if {[catch { 730 file link -hard \ 731 [file join .git objects $i] \ 732 [file join $objdir $i] 733 } err]} { 734 info_popup [mc "Hardlinks are unavailable. Falling back to copying."] 735 set i [_copy_files $this $objdir $tolink] 736 } else { 737 set i [_link_files $this $objdir [lrange $tolink 1 end]] 738 } 739 if {!$i} return 740 741 destroy $w_body 742 743 set o_status {} 744 } 745 full { 746 set o_cons [console::embed \ 747 $w_body \ 748 [mc "Cloning from %s" $origin_url]] 749 pack $w_body -fill both -expand 1 -padx 10 750 $o_cons exec \ 751 [list git fetch --no-tags -k $origin_name] \ 752 [cb _do_clone_tags] 753 } 754 shared { 755 set fd [open [gitdir objects info alternates] w] 756 fconfigure $fd -translation binary 757 puts $fd $objdir 758 close $fd 759 } 760 } 761 762 if {$clone_type eq {hardlink} || $clone_type eq {shared}} { 763 if {![_clone_refs $this]} return 764 set pwd [pwd] 765 if {[catch { 766 cd $origin_url 767 set HEAD [git rev-parse --verify HEAD^0] 768 } err]} { 769 _clone_failed $this [mc "Not a Git repository: %s" [file tail $origin_url]] 770 return 0 771 } 772 cd $pwd 773 _do_clone_checkout $this $HEAD 774 } 775} 776 777method _copy_files {objdir tocopy} { 778 set status_op [$o_status start \ 779 [mc "Copying objects"] \ 780 [mc "KiB"]] 781 set tot 0 782 set cmp 0 783 foreach p $tocopy { 784 incr tot [file size [file join $objdir $p]] 785 } 786 foreach p $tocopy { 787 if {[catch { 788 set f_in [open [file join $objdir $p] r] 789 set f_cp [open [file join .git objects $p] w] 790 fconfigure $f_in -translation binary -encoding binary 791 fconfigure $f_cp -translation binary -encoding binary 792 793 while {![eof $f_in]} { 794 incr cmp [fcopy $f_in $f_cp -size 16384] 795 $status_op update \ 796 [expr {$cmp / 1024}] \ 797 [expr {$tot / 1024}] 798 update 799 } 800 801 close $f_in 802 close $f_cp 803 } err]} { 804 _clone_failed $this [mc "Unable to copy object: %s" $err] 805 $status_op stop 806 return 0 807 } 808 } 809 $status_op stop 810 return 1 811} 812 813method _link_files {objdir tolink} { 814 set total [llength $tolink] 815 set status_op [$o_status start \ 816 [mc "Linking objects"] \ 817 [mc "objects"]] 818 for {set i 0} {$i < $total} {} { 819 set p [lindex $tolink $i] 820 if {[catch { 821 file link -hard \ 822 [file join .git objects $p] \ 823 [file join $objdir $p] 824 } err]} { 825 _clone_failed $this [mc "Unable to hardlink object: %s" $err] 826 $status_op stop 827 return 0 828 } 829 830 incr i 831 if {$i % 5 == 0} { 832 $status_op update $i $total 833 update 834 } 835 } 836 $status_op stop 837 return 1 838} 839 840method _clone_refs {} { 841 set pwd [pwd] 842 if {[catch {cd $origin_url} err]} { 843 error_popup [mc "Not a Git repository: %s" [file tail $origin_url]] 844 return 0 845 } 846 set fd_in [git_read for-each-ref \ 847 --tcl \ 848 {--format=list %(refname) %(objectname) %(*objectname)}] 849 cd $pwd 850 851 set fd [open [gitdir packed-refs] w] 852 fconfigure $fd -translation binary 853 puts $fd "# pack-refs with: peeled" 854 while {[gets $fd_in line] >= 0} { 855 set line [eval $line] 856 set refn [lindex $line 0] 857 set robj [lindex $line 1] 858 set tobj [lindex $line 2] 859 860 if {[regsub ^refs/heads/ $refn \ 861 "refs/remotes/$origin_name/" refn]} { 862 puts $fd "$robj $refn" 863 } elseif {[string match refs/tags/* $refn]} { 864 puts $fd "$robj $refn" 865 if {$tobj ne {}} { 866 puts $fd "^$tobj" 867 } 868 } 869 } 870 close $fd_in 871 close $fd 872 return 1 873} 874 875method _do_clone_tags {ok} { 876 if {$ok} { 877 $o_cons exec \ 878 [list git fetch --tags -k $origin_name] \ 879 [cb _do_clone_HEAD] 880 } else { 881 $o_cons done $ok 882 _clone_failed $this [mc "Cannot fetch branches and objects. See console output for details."] 883 } 884} 885 886method _do_clone_HEAD {ok} { 887 if {$ok} { 888 $o_cons exec \ 889 [list git fetch $origin_name HEAD] \ 890 [cb _do_clone_full_end] 891 } else { 892 $o_cons done $ok 893 _clone_failed $this [mc "Cannot fetch tags. See console output for details."] 894 } 895} 896 897method _do_clone_full_end {ok} { 898 $o_cons done $ok 899 900 if {$ok} { 901 destroy $w_body 902 903 set HEAD {} 904 if {[file exists [gitdir FETCH_HEAD]]} { 905 set fd [open [gitdir FETCH_HEAD] r] 906 while {[gets $fd line] >= 0} { 907 if {[regexp "^(.{40})\t\t" $line line HEAD]} { 908 break 909 } 910 } 911 close $fd 912 } 913 914 catch {git pack-refs} 915 _do_clone_checkout $this $HEAD 916 } else { 917 _clone_failed $this [mc "Cannot determine HEAD. See console output for details."] 918 } 919} 920 921method _clone_failed {{why {}}} { 922 if {[catch {file delete -force $local_path} err]} { 923 set why [strcat \ 924 $why \ 925 "\n\n" \ 926 [mc "Unable to cleanup %s" $local_path] \ 927 "\n\n" \ 928 $err] 929 } 930 if {$why ne {}} { 931 update 932 error_popup [strcat [mc "Clone failed."] "\n" $why] 933 } 934} 935 936method _do_clone_checkout {HEAD} { 937 if {$HEAD eq {}} { 938 info_popup [strcat \ 939 [mc "No default branch obtained."] \ 940 "\n" \ 941 [mc "The 'master' branch has not been initialized."] \ 942 ] 943 set done 1 944 return 945 } 946 if {[catch { 947 git update-ref HEAD $HEAD^0 948 } err]} { 949 info_popup [strcat \ 950 [mc "Cannot resolve %s as a commit." $HEAD^0] \ 951 "\n $err" \ 952 "\n" \ 953 [mc "The 'master' branch has not been initialized."] \ 954 ] 955 set done 1 956 return 957 } 958 959 set status [status_bar::two_line $w_body] 960 pack $w_body -fill x -padx 10 -pady 10 961 962 # We start the status operation here. 963 # 964 # This function calls _readtree_wait as a callback. 965 # 966 # _readtree_wait in turn either calls _do_clone_submodules directly, 967 # or calls _postcheckout_wait as a callback which then calls 968 # _do_clone_submodules. 969 # 970 # _do_clone_submodules calls _do_validate_submodule_cloning. 971 # 972 # _do_validate_submodule_cloning stops the status operation. 973 # 974 # There are no other calls into this chain from other code. 975 976 set o_status_op [$status start \ 977 [mc "Creating working directory"] \ 978 [mc "files"]] 979 980 set readtree_err {} 981 set fd [git_read --stderr read-tree \ 982 -m \ 983 -u \ 984 -v \ 985 HEAD \ 986 HEAD \ 987 ] 988 fconfigure $fd -blocking 0 -translation binary 989 fileevent $fd readable [cb _readtree_wait $fd] 990} 991 992method _readtree_wait {fd} { 993 set buf [read $fd] 994 $o_status_op update_meter $buf 995 append readtree_err $buf 996 997 fconfigure $fd -blocking 1 998 if {![eof $fd]} { 999 fconfigure $fd -blocking 0 1000 return 1001 } 1002 1003 if {[catch {close $fd}]} { 1004 set err $readtree_err 1005 regsub {^fatal: } $err {} err 1006 error_popup [strcat \ 1007 [mc "Initial file checkout failed."] \ 1008 "\n\n$err"] 1009 return 1010 } 1011 1012 # -- Run the post-checkout hook. 1013 # 1014 set fd_ph [githook_read post-checkout [string repeat 0 40] \ 1015 [git rev-parse HEAD] 1] 1016 if {$fd_ph ne {}} { 1017 global pch_error 1018 set pch_error {} 1019 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {} 1020 fileevent $fd_ph readable [cb _postcheckout_wait $fd_ph] 1021 } else { 1022 _do_clone_submodules $this 1023 } 1024} 1025 1026method _postcheckout_wait {fd_ph} { 1027 global pch_error 1028 1029 append pch_error [read $fd_ph] 1030 fconfigure $fd_ph -blocking 1 1031 if {[eof $fd_ph]} { 1032 if {[catch {close $fd_ph}]} { 1033 hook_failed_popup post-checkout $pch_error 0 1034 } 1035 unset pch_error 1036 _do_clone_submodules $this 1037 return 1038 } 1039 fconfigure $fd_ph -blocking 0 1040} 1041 1042method _do_clone_submodules {} { 1043 if {$recursive eq {true}} { 1044 $o_status_op stop 1045 set o_status_op {} 1046 1047 destroy $w_body 1048 1049 set o_cons [console::embed \ 1050 $w_body \ 1051 [mc "Cloning submodules"]] 1052 pack $w_body -fill both -expand 1 -padx 10 1053 $o_cons exec \ 1054 [list git submodule update --init --recursive] \ 1055 [cb _do_validate_submodule_cloning] 1056 } else { 1057 set done 1 1058 } 1059} 1060 1061method _do_validate_submodule_cloning {ok} { 1062 if {$ok} { 1063 $o_cons done $ok 1064 set done 1 1065 } else { 1066 _clone_failed $this [mc "Cannot clone submodules."] 1067 } 1068} 1069 1070###################################################################### 1071## 1072## Open Existing Repository 1073 1074method _do_open {} { 1075 global NS 1076 $w_next conf \ 1077 -state disabled \ 1078 -command [cb _do_open2] \ 1079 -text [mc "Open"] 1080 1081 ${NS}::frame $w_body 1082 ${NS}::label $w_body.h \ 1083 -font font_uibold -anchor center \ 1084 -text [mc "Open Existing Repository"] 1085 pack $w_body.h -side top -fill x -pady 10 1086 pack $w_body -fill x -padx 10 1087 1088 ${NS}::frame $w_body.where 1089 ${NS}::label $w_body.where.l -text [mc "Repository:"] 1090 ${NS}::entry $w_body.where.t \ 1091 -textvariable @local_path \ 1092 -width 50 1093 ${NS}::button $w_body.where.b \ 1094 -text [mc "Browse"] \ 1095 -command [cb _open_local_path] 1096 1097 grid $w_body.where.l $w_body.where.t $w_body.where.b -sticky ew 1098 pack $w_body.where -fill x 1099 1100 grid columnconfigure $w_body.where 1 -weight 1 1101 1102 trace add variable @local_path write [cb _write_local_path] 1103 bind $w_body.h <Destroy> [list trace remove variable @local_path write [cb _write_local_path]] 1104 update 1105 focus $w_body.where.t 1106} 1107 1108method _open_local_path {} { 1109 if {$local_path ne {}} { 1110 set p $local_path 1111 } else { 1112 set p [pwd] 1113 } 1114 1115 set p [tk_chooseDirectory \ 1116 -initialdir $p \ 1117 -parent $top \ 1118 -title [mc "Git Repository"] \ 1119 -mustexist true] 1120 if {$p eq {}} return 1121 1122 set p [file normalize $p] 1123 if {![_is_git [file join $p .git]]} { 1124 error_popup [mc "Not a Git repository: %s" [file tail $p]] 1125 return 1126 } 1127 set local_path $p 1128} 1129 1130method _do_open2 {} { 1131 if {![_is_git [file join $local_path .git] actualgit]} { 1132 error_popup [mc "Not a Git repository: %s" [file tail $local_path]] 1133 return 1134 } 1135 1136 if {[catch {cd $local_path} err]} { 1137 error_popup [strcat \ 1138 [mc "Failed to open repository %s:" $local_path] \ 1139 "\n\n$err"] 1140 return 1141 } 1142 1143 _append_recentrepos [pwd] 1144 set ::_gitdir $actualgit 1145 set ::_prefix {} 1146 set done 1 1147} 1148 1149} 1150