git.oblomov.eu Git - git/blob - lib/choose_repository.tcl

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