git-gui.sh

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3 exec wish "$0" -- "$@"
   4
   5 set appvers {@@GIT_VERSION@@}
   6 set copyright {
   7 Copyright © 2006, 2007 Shawn Pearce, Paul Mackerras.
   8
   9 This program is free software; you can redistribute it and/or modify
  10 it under the terms of the GNU General Public License as published by
  11 the Free Software Foundation; either version 2 of the License, or
  12 (at your option) any later version.
  13
  14 This program is distributed in the hope that it will be useful,
  15 but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 GNU General Public License for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with this program; if not, write to the Free Software
  21 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA}
  22
  23 ######################################################################
  24 ##
  25 ## read only globals
  26
  27 set _appname [lindex [file split $argv0] end]
  28 set _gitdir {}
  29 set _reponame {}
  30
  31 proc appname {} {
  32         global _appname
  33         return $_appname
  34 }
  35
  36 proc gitdir {args} {
  37         global _gitdir
  38         if {$args eq {}} {
  39                 return $_gitdir
  40         }
  41         return [eval [concat [list file join $_gitdir] $args]]
  42 }
  43
  44 proc reponame {} {
  45         global _reponame
  46         return $_reponame
  47 }
  48
  49 ######################################################################
  50 ##
  51 ## config
  52
  53 proc is_many_config {name} {
  54         switch -glob -- $name {
  55         remote.*.fetch -
  56         remote.*.push
  57                 {return 1}
  58         *
  59                 {return 0}
  60         }
  61 }
  62
  63 proc load_config {include_global} {
  64         global repo_config global_config default_config
  65
  66         array unset global_config
  67         if {$include_global} {
  68                 catch {
  69                         set fd_rc [open "| git repo-config --global --list" r]
  70                         while {[gets $fd_rc line] >= 0} {
  71                                 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  72                                         if {[is_many_config $name]} {
  73                                                 lappend global_config($name) $value
  74                                         } else {
  75                                                 set global_config($name) $value
  76                                         }
  77                                 }
  78                         }
  79                         close $fd_rc
  80                 }
  81         }
  82
  83         array unset repo_config
  84         catch {
  85                 set fd_rc [open "| git repo-config --list" r]
  86                 while {[gets $fd_rc line] >= 0} {
  87                         if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  88                                 if {[is_many_config $name]} {
  89                                         lappend repo_config($name) $value
  90                                 } else {
  91                                         set repo_config($name) $value
  92                                 }
  93                         }
  94                 }
  95                 close $fd_rc
  96         }
  97
  98         foreach name [array names default_config] {
  99                 if {[catch {set v $global_config($name)}]} {
 100                         set global_config($name) $default_config($name)
 101                 }
 102                 if {[catch {set v $repo_config($name)}]} {
 103                         set repo_config($name) $default_config($name)
 104                 }
 105         }
 106 }
 107
 108 proc save_config {} {
 109         global default_config font_descs
 110         global repo_config global_config
 111         global repo_config_new global_config_new
 112
 113         foreach option $font_descs {
 114                 set name [lindex $option 0]
 115                 set font [lindex $option 1]
 116                 font configure $font \
 117                         -family $global_config_new(gui.$font^^family) \
 118                         -size $global_config_new(gui.$font^^size)
 119                 font configure ${font}bold \
 120                         -family $global_config_new(gui.$font^^family) \
 121                         -size $global_config_new(gui.$font^^size)
 122                 set global_config_new(gui.$name) [font configure $font]
 123                 unset global_config_new(gui.$font^^family)
 124                 unset global_config_new(gui.$font^^size)
 125         }
 126
 127         foreach name [array names default_config] {
 128                 set value $global_config_new($name)
 129                 if {$value ne $global_config($name)} {
 130                         if {$value eq $default_config($name)} {
 131                                 catch {exec git repo-config --global --unset $name}
 132                         } else {
 133                                 regsub -all "\[{}\]" $value {"} value
 134                                 exec git repo-config --global $name $value
 135                         }
 136                         set global_config($name) $value
 137                         if {$value eq $repo_config($name)} {
 138                                 catch {exec git repo-config --unset $name}
 139                                 set repo_config($name) $value
 140                         }
 141                 }
 142         }
 143
 144         foreach name [array names default_config] {
 145                 set value $repo_config_new($name)
 146                 if {$value ne $repo_config($name)} {
 147                         if {$value eq $global_config($name)} {
 148                                 catch {exec git repo-config --unset $name}
 149                         } else {
 150                                 regsub -all "\[{}\]" $value {"} value
 151                                 exec git repo-config $name $value
 152                         }
 153                         set repo_config($name) $value
 154                 }
 155         }
 156 }
 157
 158 proc error_popup {msg} {
 159         set title [appname]
 160         if {[reponame] ne {}} {
 161                 append title " ([reponame])"
 162         }
 163         set cmd [list tk_messageBox \
 164                 -icon error \
 165                 -type ok \
 166                 -title "$title: error" \
 167                 -message $msg]
 168         if {[winfo ismapped .]} {
 169                 lappend cmd -parent .
 170         }
 171         eval $cmd
 172 }
 173
 174 proc warn_popup {msg} {
 175         set title [appname]
 176         if {[reponame] ne {}} {
 177                 append title " ([reponame])"
 178         }
 179         set cmd [list tk_messageBox \
 180                 -icon warning \
 181                 -type ok \
 182                 -title "$title: warning" \
 183                 -message $msg]
 184         if {[winfo ismapped .]} {
 185                 lappend cmd -parent .
 186         }
 187         eval $cmd
 188 }
 189
 190 proc info_popup {msg} {
 191         set title [appname]
 192         if {[reponame] ne {}} {
 193                 append title " ([reponame])"
 194         }
 195         tk_messageBox \
 196                 -parent . \
 197                 -icon info \
 198                 -type ok \
 199                 -title $title \
 200                 -message $msg
 201 }
 202
 203 proc ask_popup {msg} {
 204         set title [appname]
 205         if {[reponame] ne {}} {
 206                 append title " ([reponame])"
 207         }
 208         return [tk_messageBox \
 209                 -parent . \
 210                 -icon question \
 211                 -type yesno \
 212                 -title $title \
 213                 -message $msg]
 214 }
 215
 216 ######################################################################
 217 ##
 218 ## repository setup
 219
 220 if {   [catch {set _gitdir $env(GIT_DIR)}]
 221         && [catch {set _gitdir [exec git rev-parse --git-dir]} err]} {
 222         catch {wm withdraw .}
 223         error_popup "Cannot find the git directory:\n\n$err"
 224         exit 1
 225 }
 226 if {![file isdirectory $_gitdir]} {
 227         catch {wm withdraw .}
 228         error_popup "Git directory not found:\n\n$_gitdir"
 229         exit 1
 230 }
 231 if {[lindex [file split $_gitdir] end] ne {.git}} {
 232         catch {wm withdraw .}
 233         error_popup "Cannot use funny .git directory:\n\n$gitdir"
 234         exit 1
 235 }
 236 if {[catch {cd [file dirname $_gitdir]} err]} {
 237         catch {wm withdraw .}
 238         error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
 239         exit 1
 240 }
 241 set _reponame [lindex [file split \
 242         [file normalize [file dirname $_gitdir]]] \
 243         end]
 244
 245 set single_commit 0
 246 if {[appname] eq {git-citool}} {
 247         set single_commit 1
 248 }
 249
 250 ######################################################################
 251 ##
 252 ## task management
 253
 254 set rescan_active 0
 255 set diff_active 0
 256 set last_clicked {}
 257
 258 set disable_on_lock [list]
 259 set index_lock_type none
 260
 261 proc lock_index {type} {
 262         global index_lock_type disable_on_lock
 263
 264         if {$index_lock_type eq {none}} {
 265                 set index_lock_type $type
 266                 foreach w $disable_on_lock {
 267                         uplevel #0 $w disabled
 268                 }
 269                 return 1
 270         } elseif {$index_lock_type eq "begin-$type"} {
 271                 set index_lock_type $type
 272                 return 1
 273         }
 274         return 0
 275 }
 276
 277 proc unlock_index {} {
 278         global index_lock_type disable_on_lock
 279
 280         set index_lock_type none
 281         foreach w $disable_on_lock {
 282                 uplevel #0 $w normal
 283         }
 284 }
 285
 286 ######################################################################
 287 ##
 288 ## status
 289
 290 proc repository_state {ctvar hdvar mhvar} {
 291         global current_branch
 292         upvar $ctvar ct $hdvar hd $mhvar mh
 293
 294         set mh [list]
 295
 296         if {[catch {set current_branch [exec git symbolic-ref HEAD]}]} {
 297                 set current_branch {}
 298         } else {
 299                 regsub ^refs/((heads|tags|remotes)/)? \
 300                         $current_branch \
 301                         {} \
 302                         current_branch
 303         }
 304
 305         if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
 306                 set hd {}
 307                 set ct initial
 308                 return
 309         }
 310
 311         set merge_head [gitdir MERGE_HEAD]
 312         if {[file exists $merge_head]} {
 313                 set ct merge
 314                 set fd_mh [open $merge_head r]
 315                 while {[gets $fd_mh line] >= 0} {
 316                         lappend mh $line
 317                 }
 318                 close $fd_mh
 319                 return
 320         }
 321
 322         set ct normal
 323 }
 324
 325 proc PARENT {} {
 326         global PARENT empty_tree
 327
 328         set p [lindex $PARENT 0]
 329         if {$p ne {}} {
 330                 return $p
 331         }
 332         if {$empty_tree eq {}} {
 333                 set empty_tree [exec git mktree << {}]
 334         }
 335         return $empty_tree
 336 }
 337
 338 proc rescan {after} {
 339         global HEAD PARENT MERGE_HEAD commit_type
 340         global ui_index ui_workdir ui_status_value ui_comm
 341         global rescan_active file_states
 342         global repo_config
 343
 344         if {$rescan_active > 0 || ![lock_index read]} return
 345
 346         repository_state newType newHEAD newMERGE_HEAD
 347         if {[string match amend* $commit_type]
 348                 && $newType eq {normal}
 349                 && $newHEAD eq $HEAD} {
 350         } else {
 351                 set HEAD $newHEAD
 352                 set PARENT $newHEAD
 353                 set MERGE_HEAD $newMERGE_HEAD
 354                 set commit_type $newType
 355         }
 356
 357         array unset file_states
 358
 359         if {![$ui_comm edit modified]
 360                 || [string trim [$ui_comm get 0.0 end]] eq {}} {
 361                 if {[load_message GITGUI_MSG]} {
 362                 } elseif {[load_message MERGE_MSG]} {
 363                 } elseif {[load_message SQUASH_MSG]} {
 364                 }
 365                 $ui_comm edit reset
 366                 $ui_comm edit modified false
 367         }
 368
 369         if {$repo_config(gui.trustmtime) eq {true}} {
 370                 rescan_stage2 {} $after
 371         } else {
 372                 set rescan_active 1
 373                 set ui_status_value {Refreshing file status...}
 374                 set cmd [list git update-index]
 375                 lappend cmd -q
 376                 lappend cmd --unmerged
 377                 lappend cmd --ignore-missing
 378                 lappend cmd --refresh
 379                 set fd_rf [open "| $cmd" r]
 380                 fconfigure $fd_rf -blocking 0 -translation binary
 381                 fileevent $fd_rf readable \
 382                         [list rescan_stage2 $fd_rf $after]
 383         }
 384 }
 385
 386 proc rescan_stage2 {fd after} {
 387         global ui_status_value
 388         global rescan_active buf_rdi buf_rdf buf_rlo
 389
 390         if {$fd ne {}} {
 391                 read $fd
 392                 if {![eof $fd]} return
 393                 close $fd
 394         }
 395
 396         set ls_others [list | git ls-files --others -z \
 397                 --exclude-per-directory=.gitignore]
 398         set info_exclude [gitdir info exclude]
 399         if {[file readable $info_exclude]} {
 400                 lappend ls_others "--exclude-from=$info_exclude"
 401         }
 402
 403         set buf_rdi {}
 404         set buf_rdf {}
 405         set buf_rlo {}
 406
 407         set rescan_active 3
 408         set ui_status_value {Scanning for modified files ...}
 409         set fd_di [open "| git diff-index --cached -z [PARENT]" r]
 410         set fd_df [open "| git diff-files -z" r]
 411         set fd_lo [open $ls_others r]
 412
 413         fconfigure $fd_di -blocking 0 -translation binary
 414         fconfigure $fd_df -blocking 0 -translation binary
 415         fconfigure $fd_lo -blocking 0 -translation binary
 416         fileevent $fd_di readable [list read_diff_index $fd_di $after]
 417         fileevent $fd_df readable [list read_diff_files $fd_df $after]
 418         fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
 419 }
 420
 421 proc load_message {file} {
 422         global ui_comm
 423
 424         set f [gitdir $file]
 425         if {[file isfile $f]} {
 426                 if {[catch {set fd [open $f r]}]} {
 427                         return 0
 428                 }
 429                 set content [string trim [read $fd]]
 430                 close $fd
 431                 $ui_comm delete 0.0 end
 432                 $ui_comm insert end $content
 433                 return 1
 434         }
 435         return 0
 436 }
 437
 438 proc read_diff_index {fd after} {
 439         global buf_rdi
 440
 441         append buf_rdi [read $fd]
 442         set c 0
 443         set n [string length $buf_rdi]
 444         while {$c < $n} {
 445                 set z1 [string first "\0" $buf_rdi $c]
 446                 if {$z1 == -1} break
 447                 incr z1
 448                 set z2 [string first "\0" $buf_rdi $z1]
 449                 if {$z2 == -1} break
 450
 451                 incr c
 452                 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
 453                 merge_state \
 454                         [string range $buf_rdi $z1 [expr {$z2 - 1}]] \
 455                         [lindex $i 4]? \
 456                         [list [lindex $i 0] [lindex $i 2]] \
 457                         [list]
 458                 set c $z2
 459                 incr c
 460         }
 461         if {$c < $n} {
 462                 set buf_rdi [string range $buf_rdi $c end]
 463         } else {
 464                 set buf_rdi {}
 465         }
 466
 467         rescan_done $fd buf_rdi $after
 468 }
 469
 470 proc read_diff_files {fd after} {
 471         global buf_rdf
 472
 473         append buf_rdf [read $fd]
 474         set c 0
 475         set n [string length $buf_rdf]
 476         while {$c < $n} {
 477                 set z1 [string first "\0" $buf_rdf $c]
 478                 if {$z1 == -1} break
 479                 incr z1
 480                 set z2 [string first "\0" $buf_rdf $z1]
 481                 if {$z2 == -1} break
 482
 483                 incr c
 484                 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
 485                 merge_state \
 486                         [string range $buf_rdf $z1 [expr {$z2 - 1}]] \
 487                         ?[lindex $i 4] \
 488                         [list] \
 489                         [list [lindex $i 0] [lindex $i 2]]
 490                 set c $z2
 491                 incr c
 492         }
 493         if {$c < $n} {
 494                 set buf_rdf [string range $buf_rdf $c end]
 495         } else {
 496                 set buf_rdf {}
 497         }
 498
 499         rescan_done $fd buf_rdf $after
 500 }
 501
 502 proc read_ls_others {fd after} {
 503         global buf_rlo
 504
 505         append buf_rlo [read $fd]
 506         set pck [split $buf_rlo "\0"]
 507         set buf_rlo [lindex $pck end]
 508         foreach p [lrange $pck 0 end-1] {
 509                 merge_state $p ?O
 510         }
 511         rescan_done $fd buf_rlo $after
 512 }
 513
 514 proc rescan_done {fd buf after} {
 515         global rescan_active
 516         global file_states repo_config
 517         upvar $buf to_clear
 518
 519         if {![eof $fd]} return
 520         set to_clear {}
 521         close $fd
 522         if {[incr rescan_active -1] > 0} return
 523
 524         prune_selection
 525         unlock_index
 526         display_all_files
 527         reshow_diff
 528         uplevel #0 $after
 529 }
 530
 531 proc prune_selection {} {
 532         global file_states selected_paths
 533
 534         foreach path [array names selected_paths] {
 535                 if {[catch {set still_here $file_states($path)}]} {
 536                         unset selected_paths($path)
 537                 }
 538         }
 539 }
 540
 541 ######################################################################
 542 ##
 543 ## diff
 544
 545 proc clear_diff {} {
 546         global ui_diff current_diff_path ui_index ui_workdir
 547
 548         $ui_diff conf -state normal
 549         $ui_diff delete 0.0 end
 550         $ui_diff conf -state disabled
 551
 552         set current_diff_path {}
 553
 554         $ui_index tag remove in_diff 0.0 end
 555         $ui_workdir tag remove in_diff 0.0 end
 556 }
 557
 558 proc reshow_diff {} {
 559         global ui_status_value file_states file_lists
 560         global current_diff_path current_diff_side
 561
 562         set p $current_diff_path
 563         if {$p eq {}
 564                 || $current_diff_side eq {}
 565                 || [catch {set s $file_states($p)}]
 566                 || [lsearch -sorted $file_lists($current_diff_side) $p] == -1} {
 567                 clear_diff
 568         } else {
 569                 show_diff $p $current_diff_side
 570         }
 571 }
 572
 573 proc handle_empty_diff {} {
 574         global current_diff_path file_states file_lists
 575
 576         set path $current_diff_path
 577         set s $file_states($path)
 578         if {[lindex $s 0] ne {_M}} return
 579
 580         info_popup "No differences detected.
 581
 582 [short_path $path] has no changes.
 583
 584 The modification date of this file was updated
 585 by another application and you currently have
 586 the Trust File Modification Timestamps option
 587 enabled, so Git did not automatically detect
 588 that there are no content differences in this
 589 file.
 590
 591 This file will now be removed from the modified
 592 files list, to prevent possible confusion.
 593 "
 594         if {[catch {exec git update-index -- $path} err]} {
 595                 error_popup "Failed to refresh index:\n\n$err"
 596         }
 597
 598         clear_diff
 599         display_file $path __
 600 }
 601
 602 proc show_diff {path w {lno {}}} {
 603         global file_states file_lists
 604         global is_3way_diff diff_active repo_config
 605         global ui_diff ui_status_value ui_index ui_workdir
 606         global current_diff_path current_diff_side
 607
 608         if {$diff_active || ![lock_index read]} return
 609
 610         clear_diff
 611         if {$w eq {} || $lno == {}} {
 612                 foreach w [array names file_lists] {
 613                         set lno [lsearch -sorted $file_lists($w) $path]
 614                         if {$lno >= 0} {
 615                                 incr lno
 616                                 break
 617                         }
 618                 }
 619         }
 620         if {$w ne {} && $lno >= 1} {
 621                 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
 622         }
 623
 624         set s $file_states($path)
 625         set m [lindex $s 0]
 626         set is_3way_diff 0
 627         set diff_active 1
 628         set current_diff_path $path
 629         set current_diff_side $w
 630         set ui_status_value "Loading diff of [escape_path $path]..."
 631
 632         # - Git won't give us the diff, there's nothing to compare to!
 633         #
 634         if {$m eq {_O}} {
 635                 if {[catch {
 636                                 set fd [open $path r]
 637                                 set content [read $fd]
 638                                 close $fd
 639                         } err ]} {
 640                         set diff_active 0
 641                         unlock_index
 642                         set ui_status_value "Unable to display [escape_path $path]"
 643                         error_popup "Error loading file:\n\n$err"
 644                         return
 645                 }
 646                 $ui_diff conf -state normal
 647                 $ui_diff insert end $content
 648                 $ui_diff conf -state disabled
 649                 set diff_active 0
 650                 unlock_index
 651                 set ui_status_value {Ready.}
 652                 return
 653         }
 654
 655         set cmd [list | git]
 656         if {$w eq $ui_index} {
 657                 lappend cmd diff-index
 658                 lappend cmd --cached
 659         } elseif {$w eq $ui_workdir} {
 660                 if {[string index $m 0] eq {U}} {
 661                         lappend cmd diff
 662                 } else {
 663                         lappend cmd diff-files
 664                 }
 665         }
 666
 667         lappend cmd -p
 668         lappend cmd --no-color
 669         if {$repo_config(gui.diffcontext) > 0} {
 670                 lappend cmd "-U$repo_config(gui.diffcontext)"
 671         }
 672         if {$w eq $ui_index} {
 673                 lappend cmd [PARENT]
 674         }
 675         lappend cmd --
 676         lappend cmd $path
 677
 678         if {[catch {set fd [open $cmd r]} err]} {
 679                 set diff_active 0
 680                 unlock_index
 681                 set ui_status_value "Unable to display [escape_path $path]"
 682                 error_popup "Error loading diff:\n\n$err"
 683                 return
 684         }
 685
 686         fconfigure $fd -blocking 0 -translation auto
 687         fileevent $fd readable [list read_diff $fd]
 688 }
 689
 690 proc read_diff {fd} {
 691         global ui_diff ui_status_value is_3way_diff diff_active
 692         global repo_config
 693
 694         $ui_diff conf -state normal
 695         while {[gets $fd line] >= 0} {
 696                 # -- Cleanup uninteresting diff header lines.
 697                 #
 698                 if {[string match {diff --git *}      $line]} continue
 699                 if {[string match {diff --cc *}       $line]} continue
 700                 if {[string match {diff --combined *} $line]} continue
 701                 if {[string match {--- *}             $line]} continue
 702                 if {[string match {+++ *}             $line]} continue
 703                 if {$line eq {deleted file mode 120000}} {
 704                         set line "deleted symlink"
 705                 }
 706
 707                 # -- Automatically detect if this is a 3 way diff.
 708                 #
 709                 if {[string match {@@@ *} $line]} {set is_3way_diff 1}
 710
 711                 if {[string match {index *} $line]
 712                         || [regexp {^\* Unmerged path } $line]} {
 713                         set tags {}
 714                 } elseif {$is_3way_diff} {
 715                         set op [string range $line 0 1]
 716                         switch -- $op {
 717                         {  } {set tags {}}
 718                         {@@} {set tags d_@}
 719                         { +} {set tags d_s+}
 720                         { -} {set tags d_s-}
 721                         {+ } {set tags d_+s}
 722                         {- } {set tags d_-s}
 723                         {--} {set tags d_--}
 724                         {++} {
 725                                 if {[regexp {^\+\+([<>]{7} |={7})} $line _g op]} {
 726                                         set line [string replace $line 0 1 {  }]
 727                                         set tags d$op
 728                                 } else {
 729                                         set tags d_++
 730                                 }
 731                         }
 732                         default {
 733                                 puts "error: Unhandled 3 way diff marker: {$op}"
 734                                 set tags {}
 735                         }
 736                         }
 737                 } else {
 738                         set op [string index $line 0]
 739                         switch -- $op {
 740                         { } {set tags {}}
 741                         {@} {set tags d_@}
 742                         {-} {set tags d_-}
 743                         {+} {
 744                                 if {[regexp {^\+([<>]{7} |={7})} $line _g op]} {
 745                                         set line [string replace $line 0 0 { }]
 746                                         set tags d$op
 747                                 } else {
 748                                         set tags d_+
 749                                 }
 750                         }
 751                         default {
 752                                 puts "error: Unhandled 2 way diff marker: {$op}"
 753                                 set tags {}
 754                         }
 755                         }
 756                 }
 757                 $ui_diff insert end $line $tags
 758                 $ui_diff insert end "\n" $tags
 759         }
 760         $ui_diff conf -state disabled
 761
 762         if {[eof $fd]} {
 763                 close $fd
 764                 set diff_active 0
 765                 unlock_index
 766                 set ui_status_value {Ready.}
 767
 768                 if {$repo_config(gui.trustmtime) eq {true}
 769                         && [$ui_diff index end] eq {2.0}} {
 770                         handle_empty_diff
 771                 }
 772         }
 773 }
 774
 775 ######################################################################
 776 ##
 777 ## commit
 778
 779 proc load_last_commit {} {
 780         global HEAD PARENT MERGE_HEAD commit_type ui_comm
 781
 782         if {[llength $PARENT] == 0} {
 783                 error_popup {There is nothing to amend.
 784
 785 You are about to create the initial commit.
 786 There is no commit before this to amend.
 787 }
 788                 return
 789         }
 790
 791         repository_state curType curHEAD curMERGE_HEAD
 792         if {$curType eq {merge}} {
 793                 error_popup {Cannot amend while merging.
 794
 795 You are currently in the middle of a merge that
 796 has not been fully completed.  You cannot amend
 797 the prior commit unless you first abort the
 798 current merge activity.
 799 }
 800                 return
 801         }
 802
 803         set msg {}
 804         set parents [list]
 805         if {[catch {
 806                         set fd [open "| git cat-file commit $curHEAD" r]
 807                         while {[gets $fd line] > 0} {
 808                                 if {[string match {parent *} $line]} {
 809                                         lappend parents [string range $line 7 end]
 810                                 }
 811                         }
 812                         set msg [string trim [read $fd]]
 813                         close $fd
 814                 } err]} {
 815                 error_popup "Error loading commit data for amend:\n\n$err"
 816                 return
 817         }
 818
 819         set HEAD $curHEAD
 820         set PARENT $parents
 821         set MERGE_HEAD [list]
 822         switch -- [llength $parents] {
 823         0       {set commit_type amend-initial}
 824         1       {set commit_type amend}
 825         default {set commit_type amend-merge}
 826         }
 827
 828         $ui_comm delete 0.0 end
 829         $ui_comm insert end $msg
 830         $ui_comm edit reset
 831         $ui_comm edit modified false
 832         rescan {set ui_status_value {Ready.}}
 833 }
 834
 835 proc create_new_commit {} {
 836         global commit_type ui_comm
 837
 838         set commit_type normal
 839         $ui_comm delete 0.0 end
 840         $ui_comm edit reset
 841         $ui_comm edit modified false
 842         rescan {set ui_status_value {Ready.}}
 843 }
 844
 845 set GIT_COMMITTER_IDENT {}
 846
 847 proc committer_ident {} {
 848         global GIT_COMMITTER_IDENT
 849
 850         if {$GIT_COMMITTER_IDENT eq {}} {
 851                 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
 852                         error_popup "Unable to obtain your identity:\n\n$err"
 853                         return {}
 854                 }
 855                 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
 856                         $me me GIT_COMMITTER_IDENT]} {
 857                         error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
 858                         return {}
 859                 }
 860         }
 861
 862         return $GIT_COMMITTER_IDENT
 863 }
 864
 865 proc commit_tree {} {
 866         global HEAD commit_type file_states ui_comm repo_config
 867         global ui_status_value pch_error
 868
 869         if {![lock_index update]} return
 870         if {[committer_ident] eq {}} return
 871
 872         # -- Our in memory state should match the repository.
 873         #
 874         repository_state curType curHEAD curMERGE_HEAD
 875         if {[string match amend* $commit_type]
 876                 && $curType eq {normal}
 877                 && $curHEAD eq $HEAD} {
 878         } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
 879                 info_popup {Last scanned state does not match repository state.
 880
 881 Another Git program has modified this repository
 882 since the last scan.  A rescan must be performed
 883 before another commit can be created.
 884
 885 The rescan will be automatically started now.
 886 }
 887                 unlock_index
 888                 rescan {set ui_status_value {Ready.}}
 889                 return
 890         }
 891
 892         # -- At least one file should differ in the index.
 893         #
 894         set files_ready 0
 895         foreach path [array names file_states] {
 896                 switch -glob -- [lindex $file_states($path) 0] {
 897                 _? {continue}
 898                 A? -
 899                 D? -
 900                 M? {set files_ready 1}
 901                 U? {
 902                         error_popup "Unmerged files cannot be committed.
 903
 904 File [short_path $path] has merge conflicts.
 905 You must resolve them and add the file before committing.
 906 "
 907                         unlock_index
 908                         return
 909                 }
 910                 default {
 911                         error_popup "Unknown file state [lindex $s 0] detected.
 912
 913 File [short_path $path] cannot be committed by this program.
 914 "
 915                 }
 916                 }
 917         }
 918         if {!$files_ready} {
 919                 info_popup {No changes to commit.
 920
 921 You must add at least 1 file before you can commit.
 922 }
 923                 unlock_index
 924                 return
 925         }
 926
 927         # -- A message is required.
 928         #
 929         set msg [string trim [$ui_comm get 1.0 end]]
 930         if {$msg eq {}} {
 931                 error_popup {Please supply a commit message.
 932
 933 A good commit message has the following format:
 934
 935 - First line: Describe in one sentance what you did.
 936 - Second line: Blank
 937 - Remaining lines: Describe why this change is good.
 938 }
 939                 unlock_index
 940                 return
 941         }
 942
 943         # -- Run the pre-commit hook.
 944         #
 945         set pchook [gitdir hooks pre-commit]
 946
 947         # On Cygwin [file executable] might lie so we need to ask
 948         # the shell if the hook is executable.  Yes that's annoying.
 949         #
 950         if {[is_Windows] && [file isfile $pchook]} {
 951                 set pchook [list sh -c [concat \
 952                         "if test -x \"$pchook\";" \
 953                         "then exec \"$pchook\" 2>&1;" \
 954                         "fi"]]
 955         } elseif {[file executable $pchook]} {
 956                 set pchook [list $pchook |& cat]
 957         } else {
 958                 commit_writetree $curHEAD $msg
 959                 return
 960         }
 961
 962         set ui_status_value {Calling pre-commit hook...}
 963         set pch_error {}
 964         set fd_ph [open "| $pchook" r]
 965         fconfigure $fd_ph -blocking 0 -translation binary
 966         fileevent $fd_ph readable \
 967                 [list commit_prehook_wait $fd_ph $curHEAD $msg]
 968 }
 969
 970 proc commit_prehook_wait {fd_ph curHEAD msg} {
 971         global pch_error ui_status_value
 972
 973         append pch_error [read $fd_ph]
 974         fconfigure $fd_ph -blocking 1
 975         if {[eof $fd_ph]} {
 976                 if {[catch {close $fd_ph}]} {
 977                         set ui_status_value {Commit declined by pre-commit hook.}
 978                         hook_failed_popup pre-commit $pch_error
 979                         unlock_index
 980                 } else {
 981                         commit_writetree $curHEAD $msg
 982                 }
 983                 set pch_error {}
 984                 return
 985         }
 986         fconfigure $fd_ph -blocking 0
 987 }
 988
 989 proc commit_writetree {curHEAD msg} {
 990         global ui_status_value
 991
 992         set ui_status_value {Committing changes...}
 993         set fd_wt [open "| git write-tree" r]
 994         fileevent $fd_wt readable \
 995                 [list commit_committree $fd_wt $curHEAD $msg]
 996 }
 997
 998 proc commit_committree {fd_wt curHEAD msg} {
 999         global HEAD PARENT MERGE_HEAD commit_type
1000         global single_commit
1001         global ui_status_value ui_comm selected_commit_type
1002         global file_states selected_paths rescan_active
1003
1004         gets $fd_wt tree_id
1005         if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1006                 error_popup "write-tree failed:\n\n$err"
1007                 set ui_status_value {Commit failed.}
1008                 unlock_index
1009                 return
1010         }
1011
1012         # -- Create the commit.
1013         #
1014         set cmd [list git commit-tree $tree_id]
1015         set parents [concat $PARENT $MERGE_HEAD]
1016         if {[llength $parents] > 0} {
1017                 foreach p $parents {
1018                         lappend cmd -p $p
1019                 }
1020         } else {
1021                 # git commit-tree writes to stderr during initial commit.
1022                 lappend cmd 2>/dev/null
1023         }
1024         lappend cmd << $msg
1025         if {[catch {set cmt_id [eval exec $cmd]} err]} {
1026                 error_popup "commit-tree failed:\n\n$err"
1027                 set ui_status_value {Commit failed.}
1028                 unlock_index
1029                 return
1030         }
1031
1032         # -- Update the HEAD ref.
1033         #
1034         set reflogm commit
1035         if {$commit_type ne {normal}} {
1036                 append reflogm " ($commit_type)"
1037         }
1038         set i [string first "\n" $msg]
1039         if {$i >= 0} {
1040                 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1041         } else {
1042                 append reflogm {: } $msg
1043         }
1044         set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1045         if {[catch {eval exec $cmd} err]} {
1046                 error_popup "update-ref failed:\n\n$err"
1047                 set ui_status_value {Commit failed.}
1048                 unlock_index
1049                 return
1050         }
1051
1052         # -- Cleanup after ourselves.
1053         #
1054         catch {file delete [gitdir MERGE_HEAD]}
1055         catch {file delete [gitdir MERGE_MSG]}
1056         catch {file delete [gitdir SQUASH_MSG]}
1057         catch {file delete [gitdir GITGUI_MSG]}
1058
1059         # -- Let rerere do its thing.
1060         #
1061         if {[file isdirectory [gitdir rr-cache]]} {
1062                 catch {exec git rerere}
1063         }
1064
1065         # -- Run the post-commit hook.
1066         #
1067         set pchook [gitdir hooks post-commit]
1068         if {[is_Windows] && [file isfile $pchook]} {
1069                 set pchook [list sh -c [concat \
1070                         "if test -x \"$pchook\";" \
1071                         "then exec \"$pchook\";" \
1072                         "fi"]]
1073         } elseif {![file executable $pchook]} {
1074                 set pchook {}
1075         }
1076         if {$pchook ne {}} {
1077                 catch {exec $pchook &}
1078         }
1079
1080         $ui_comm delete 0.0 end
1081         $ui_comm edit reset
1082         $ui_comm edit modified false
1083
1084         if {$single_commit} do_quit
1085
1086         # -- Update in memory status
1087         #
1088         set selected_commit_type new
1089         set commit_type normal
1090         set HEAD $cmt_id
1091         set PARENT $cmt_id
1092         set MERGE_HEAD [list]
1093
1094         foreach path [array names file_states] {
1095                 set s $file_states($path)
1096                 set m [lindex $s 0]
1097                 switch -glob -- $m {
1098                 _O -
1099                 _M -
1100                 _D {continue}
1101                 __ -
1102                 A_ -
1103                 M_ -
1104                 D_ {
1105                         unset file_states($path)
1106                         catch {unset selected_paths($path)}
1107                 }
1108                 DO {
1109                         set file_states($path) [list _O [lindex $s 1] {} {}]
1110                 }
1111                 AM -
1112                 AD -
1113                 MM -
1114                 MD {
1115                         set file_states($path) [list \
1116                                 _[string index $m 1] \
1117                                 [lindex $s 1] \
1118                                 [lindex $s 3] \
1119                                 {}]
1120                 }
1121                 }
1122         }
1123
1124         display_all_files
1125         unlock_index
1126         reshow_diff
1127         set ui_status_value \
1128                 "Changes committed as [string range $cmt_id 0 7]."
1129 }
1130
1131 ######################################################################
1132 ##
1133 ## fetch pull push
1134
1135 proc fetch_from {remote} {
1136         set w [new_console "fetch $remote" \
1137                 "Fetching new changes from $remote"]
1138         set cmd [list git fetch]
1139         lappend cmd $remote
1140         console_exec $w $cmd
1141 }
1142
1143 proc pull_remote {remote branch} {
1144         global HEAD commit_type file_states repo_config
1145
1146         if {![lock_index update]} return
1147
1148         # -- Our in memory state should match the repository.
1149         #
1150         repository_state curType curHEAD curMERGE_HEAD
1151         if {$commit_type ne $curType || $HEAD ne $curHEAD} {
1152                 info_popup {Last scanned state does not match repository state.
1153
1154 Another Git program has modified this repository
1155 since the last scan.  A rescan must be performed
1156 before a pull operation can be started.
1157
1158 The rescan will be automatically started now.
1159 }
1160                 unlock_index
1161                 rescan {set ui_status_value {Ready.}}
1162                 return
1163         }
1164
1165         # -- No differences should exist before a pull.
1166         #
1167         if {[array size file_states] != 0} {
1168                 error_popup {Uncommitted but modified files are present.
1169
1170 You should not perform a pull with unmodified
1171 files in your working directory as Git will be
1172 unable to recover from an incorrect merge.
1173
1174 You should commit or revert all changes before
1175 starting a pull operation.
1176 }
1177                 unlock_index
1178                 return
1179         }
1180
1181         set w [new_console "pull $remote $branch" \
1182                 "Pulling new changes from branch $branch in $remote"]
1183         set cmd [list git pull]
1184         if {$repo_config(gui.pullsummary) eq {false}} {
1185                 lappend cmd --no-summary
1186         }
1187         lappend cmd $remote
1188         lappend cmd $branch
1189         console_exec $w $cmd [list post_pull_remote $remote $branch]
1190 }
1191
1192 proc post_pull_remote {remote branch success} {
1193         global HEAD PARENT MERGE_HEAD commit_type selected_commit_type
1194         global ui_status_value
1195
1196         unlock_index
1197         if {$success} {
1198                 repository_state commit_type HEAD MERGE_HEAD
1199                 set PARENT $HEAD
1200                 set selected_commit_type new
1201                 set ui_status_value "Pulling $branch from $remote complete."
1202         } else {
1203                 rescan [list set ui_status_value \
1204                         "Conflicts detected while pulling $branch from $remote."]
1205         }
1206 }
1207
1208 proc push_to {remote} {
1209         set w [new_console "push $remote" \
1210                 "Pushing changes to $remote"]
1211         set cmd [list git push]
1212         lappend cmd $remote
1213         console_exec $w $cmd
1214 }
1215
1216 ######################################################################
1217 ##
1218 ## ui helpers
1219
1220 proc mapicon {w state path} {
1221         global all_icons
1222
1223         if {[catch {set r $all_icons($state$w)}]} {
1224                 puts "error: no icon for $w state={$state} $path"
1225                 return file_plain
1226         }
1227         return $r
1228 }
1229
1230 proc mapdesc {state path} {
1231         global all_descs
1232
1233         if {[catch {set r $all_descs($state)}]} {
1234                 puts "error: no desc for state={$state} $path"
1235                 return $state
1236         }
1237         return $r
1238 }
1239
1240 proc escape_path {path} {
1241         regsub -all "\n" $path "\\n" path
1242         return $path
1243 }
1244
1245 proc short_path {path} {
1246         return [escape_path [lindex [file split $path] end]]
1247 }
1248
1249 set next_icon_id 0
1250 set null_sha1 [string repeat 0 40]
1251
1252 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1253         global file_states next_icon_id null_sha1
1254
1255         set s0 [string index $new_state 0]
1256         set s1 [string index $new_state 1]
1257
1258         if {[catch {set info $file_states($path)}]} {
1259                 set state __
1260                 set icon n[incr next_icon_id]
1261         } else {
1262                 set state [lindex $info 0]
1263                 set icon [lindex $info 1]
1264                 if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1265                 if {$index_info eq {}} {set index_info [lindex $info 3]}
1266         }
1267
1268         if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1269         elseif {$s0 eq {_}} {set s0 _}
1270
1271         if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1272         elseif {$s1 eq {_}} {set s1 _}
1273
1274         if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1275                 set head_info [list 0 $null_sha1]
1276         } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1277                 && $head_info eq {}} {
1278                 set head_info $index_info
1279         }
1280
1281         set file_states($path) [list $s0$s1 $icon \
1282                 $head_info $index_info \
1283                 ]
1284         return $state
1285 }
1286
1287 proc display_file_helper {w path icon_name old_m new_m} {
1288         global file_lists
1289
1290         if {$new_m eq {_}} {
1291                 set lno [lsearch -sorted $file_lists($w) $path]
1292                 if {$lno >= 0} {
1293                         set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1294                         incr lno
1295                         $w conf -state normal
1296                         $w delete $lno.0 [expr {$lno + 1}].0
1297                         $w conf -state disabled
1298                 }
1299         } elseif {$old_m eq {_} && $new_m ne {_}} {
1300                 lappend file_lists($w) $path
1301                 set file_lists($w) [lsort -unique $file_lists($w)]
1302                 set lno [lsearch -sorted $file_lists($w) $path]
1303                 incr lno
1304                 $w conf -state normal
1305                 $w image create $lno.0 \
1306                         -align center -padx 5 -pady 1 \
1307                         -name $icon_name \
1308                         -image [mapicon $w $new_m $path]
1309                 $w insert $lno.1 "[escape_path $path]\n"
1310                 $w conf -state disabled
1311         } elseif {$old_m ne $new_m} {
1312                 $w conf -state normal
1313                 $w image conf $icon_name -image [mapicon $w $new_m $path]
1314                 $w conf -state disabled
1315         }
1316 }
1317
1318 proc display_file {path state} {
1319         global file_states selected_paths
1320         global ui_index ui_workdir
1321
1322         set old_m [merge_state $path $state]
1323         set s $file_states($path)
1324         set new_m [lindex $s 0]
1325         set icon_name [lindex $s 1]
1326
1327         set o [string index $old_m 0]
1328         set n [string index $new_m 0]
1329         if {$o eq {U}} {
1330                 set o _
1331         }
1332         if {$n eq {U}} {
1333                 set n _
1334         }
1335         display_file_helper     $ui_index $path $icon_name $o $n
1336
1337         if {[string index $old_m 0] eq {U}} {
1338                 set o U
1339         } else {
1340                 set o [string index $old_m 1]
1341         }
1342         if {[string index $new_m 0] eq {U}} {
1343                 set n U
1344         } else {
1345                 set n [string index $new_m 1]
1346         }
1347         display_file_helper     $ui_workdir $path $icon_name $o $n
1348
1349         if {$new_m eq {__}} {
1350                 unset file_states($path)
1351                 catch {unset selected_paths($path)}
1352         }
1353 }
1354
1355 proc display_all_files_helper {w path icon_name m} {
1356         global file_lists
1357
1358         lappend file_lists($w) $path
1359         set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1360         $w image create end \
1361                 -align center -padx 5 -pady 1 \
1362                 -name $icon_name \
1363                 -image [mapicon $w $m $path]
1364         $w insert end "[escape_path $path]\n"
1365 }
1366
1367 proc display_all_files {} {
1368         global ui_index ui_workdir
1369         global file_states file_lists
1370         global last_clicked
1371
1372         $ui_index conf -state normal
1373         $ui_workdir conf -state normal
1374
1375         $ui_index delete 0.0 end
1376         $ui_workdir delete 0.0 end
1377         set last_clicked {}
1378
1379         set file_lists($ui_index) [list]
1380         set file_lists($ui_workdir) [list]
1381
1382         foreach path [lsort [array names file_states]] {
1383                 set s $file_states($path)
1384                 set m [lindex $s 0]
1385                 set icon_name [lindex $s 1]
1386
1387                 set s [string index $m 0]
1388                 if {$s ne {U} && $s ne {_}} {
1389                         display_all_files_helper $ui_index $path \
1390                                 $icon_name $s
1391                 }
1392
1393                 if {[string index $m 0] eq {U}} {
1394                         set s U
1395                 } else {
1396                         set s [string index $m 1]
1397                 }
1398                 if {$s ne {_}} {
1399                         display_all_files_helper $ui_workdir $path \
1400                                 $icon_name $s
1401                 }
1402         }
1403
1404         $ui_index conf -state disabled
1405         $ui_workdir conf -state disabled
1406 }
1407
1408 proc update_indexinfo {msg pathList after} {
1409         global update_index_cp ui_status_value
1410
1411         if {![lock_index update]} return
1412
1413         set update_index_cp 0
1414         set pathList [lsort $pathList]
1415         set totalCnt [llength $pathList]
1416         set batch [expr {int($totalCnt * .01) + 1}]
1417         if {$batch > 25} {set batch 25}
1418
1419         set ui_status_value [format \
1420                 "$msg... %i/%i files (%.2f%%)" \
1421                 $update_index_cp \
1422                 $totalCnt \
1423                 0.0]
1424         set fd [open "| git update-index -z --index-info" w]
1425         fconfigure $fd \
1426                 -blocking 0 \
1427                 -buffering full \
1428                 -buffersize 512 \
1429                 -translation binary
1430         fileevent $fd writable [list \
1431                 write_update_indexinfo \
1432                 $fd \
1433                 $pathList \
1434                 $totalCnt \
1435                 $batch \
1436                 $msg \
1437                 $after \
1438                 ]
1439 }
1440
1441 proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1442         global update_index_cp ui_status_value
1443         global file_states current_diff_path
1444
1445         if {$update_index_cp >= $totalCnt} {
1446                 close $fd
1447                 unlock_index
1448                 uplevel #0 $after
1449                 return
1450         }
1451
1452         for {set i $batch} \
1453                 {$update_index_cp < $totalCnt && $i > 0} \
1454                 {incr i -1} {
1455                 set path [lindex $pathList $update_index_cp]
1456                 incr update_index_cp
1457
1458                 set s $file_states($path)
1459                 switch -glob -- [lindex $s 0] {
1460                 A? {set new _O}
1461                 M? {set new _M}
1462                 D_ {set new _D}
1463                 D? {set new _?}
1464                 ?? {continue}
1465                 }
1466                 set info [lindex $s 2]
1467                 if {$info eq {}} continue
1468
1469                 puts -nonewline $fd "$info\t$path\0"
1470                 display_file $path $new
1471         }
1472
1473         set ui_status_value [format \
1474                 "$msg... %i/%i files (%.2f%%)" \
1475                 $update_index_cp \
1476                 $totalCnt \
1477                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1478 }
1479
1480 proc update_index {msg pathList after} {
1481         global update_index_cp ui_status_value
1482
1483         if {![lock_index update]} return
1484
1485         set update_index_cp 0
1486         set pathList [lsort $pathList]
1487         set totalCnt [llength $pathList]
1488         set batch [expr {int($totalCnt * .01) + 1}]
1489         if {$batch > 25} {set batch 25}
1490
1491         set ui_status_value [format \
1492                 "$msg... %i/%i files (%.2f%%)" \
1493                 $update_index_cp \
1494                 $totalCnt \
1495                 0.0]
1496         set fd [open "| git update-index --add --remove -z --stdin" w]
1497         fconfigure $fd \
1498                 -blocking 0 \
1499                 -buffering full \
1500                 -buffersize 512 \
1501                 -translation binary
1502         fileevent $fd writable [list \
1503                 write_update_index \
1504                 $fd \
1505                 $pathList \
1506                 $totalCnt \
1507                 $batch \
1508                 $msg \
1509                 $after \
1510                 ]
1511 }
1512
1513 proc write_update_index {fd pathList totalCnt batch msg after} {
1514         global update_index_cp ui_status_value
1515         global file_states current_diff_path
1516
1517         if {$update_index_cp >= $totalCnt} {
1518                 close $fd
1519                 unlock_index
1520                 uplevel #0 $after
1521                 return
1522         }
1523
1524         for {set i $batch} \
1525                 {$update_index_cp < $totalCnt && $i > 0} \
1526                 {incr i -1} {
1527                 set path [lindex $pathList $update_index_cp]
1528                 incr update_index_cp
1529
1530                 switch -glob -- [lindex $file_states($path) 0] {
1531                 AD {set new __}
1532                 ?D {set new D_}
1533                 _O -
1534                 AM {set new A_}
1535                 U? {
1536                         if {[file exists $path]} {
1537                                 set new M_
1538                         } else {
1539                                 set new D_
1540                         }
1541                 }
1542                 ?M {set new M_}
1543                 ?? {continue}
1544                 }
1545                 puts -nonewline $fd "$path\0"
1546                 display_file $path $new
1547         }
1548
1549         set ui_status_value [format \
1550                 "$msg... %i/%i files (%.2f%%)" \
1551                 $update_index_cp \
1552                 $totalCnt \
1553                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1554 }
1555
1556 proc checkout_index {msg pathList after} {
1557         global update_index_cp ui_status_value
1558
1559         if {![lock_index update]} return
1560
1561         set update_index_cp 0
1562         set pathList [lsort $pathList]
1563         set totalCnt [llength $pathList]
1564         set batch [expr {int($totalCnt * .01) + 1}]
1565         if {$batch > 25} {set batch 25}
1566
1567         set ui_status_value [format \
1568                 "$msg... %i/%i files (%.2f%%)" \
1569                 $update_index_cp \
1570                 $totalCnt \
1571                 0.0]
1572         set cmd [list git checkout-index]
1573         lappend cmd --index
1574         lappend cmd --quiet
1575         lappend cmd --force
1576         lappend cmd -z
1577         lappend cmd --stdin
1578         set fd [open "| $cmd " w]
1579         fconfigure $fd \
1580                 -blocking 0 \
1581                 -buffering full \
1582                 -buffersize 512 \
1583                 -translation binary
1584         fileevent $fd writable [list \
1585                 write_checkout_index \
1586                 $fd \
1587                 $pathList \
1588                 $totalCnt \
1589                 $batch \
1590                 $msg \
1591                 $after \
1592                 ]
1593 }
1594
1595 proc write_checkout_index {fd pathList totalCnt batch msg after} {
1596         global update_index_cp ui_status_value
1597         global file_states current_diff_path
1598
1599         if {$update_index_cp >= $totalCnt} {
1600                 close $fd
1601                 unlock_index
1602                 uplevel #0 $after
1603                 return
1604         }
1605
1606         for {set i $batch} \
1607                 {$update_index_cp < $totalCnt && $i > 0} \
1608                 {incr i -1} {
1609                 set path [lindex $pathList $update_index_cp]
1610                 incr update_index_cp
1611                 switch -glob -- [lindex $file_states($path) 0] {
1612                 U? {continue}
1613                 ?M -
1614                 ?D {
1615                         puts -nonewline $fd "$path\0"
1616                         display_file $path ?_
1617                 }
1618                 }
1619         }
1620
1621         set ui_status_value [format \
1622                 "$msg... %i/%i files (%.2f%%)" \
1623                 $update_index_cp \
1624                 $totalCnt \
1625                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1626 }
1627
1628 ######################################################################
1629 ##
1630 ## branch management
1631
1632 proc is_tracking_branch {name} {
1633         global tracking_branches
1634
1635         if {![catch {set info $tracking_branches($name)}]} {
1636                 return 1
1637         }
1638         foreach t [array names tracking_branches] {
1639                 if {[string match {*/\*} $t] && [string match $t $name]} {
1640                         return 1
1641                 }
1642         }
1643         return 0
1644 }
1645
1646 proc load_all_heads {} {
1647         global all_heads
1648
1649         set all_heads [list]
1650         set fd [open "| git for-each-ref --format=%(refname) refs/heads" r]
1651         while {[gets $fd line] > 0} {
1652                 if {[is_tracking_branch $line]} continue
1653                 if {![regsub ^refs/heads/ $line {} name]} continue
1654                 lappend all_heads $name
1655         }
1656         close $fd
1657
1658         set all_heads [lsort $all_heads]
1659 }
1660
1661 proc populate_branch_menu {} {
1662         global all_heads disable_on_lock
1663
1664         set m .mbar.branch
1665         set last [$m index last]
1666         for {set i 0} {$i <= $last} {incr i} {
1667                 if {[$m type $i] eq {separator}} {
1668                         $m delete $i last
1669                         set new_dol [list]
1670                         foreach a $disable_on_lock {
1671                                 if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
1672                                         lappend new_dol $a
1673                                 }
1674                         }
1675                         set disable_on_lock $new_dol
1676                         break
1677                 }
1678         }
1679
1680         $m add separator
1681         foreach b $all_heads {
1682                 $m add radiobutton \
1683                         -label $b \
1684                         -command [list switch_branch $b] \
1685                         -variable current_branch \
1686                         -value $b \
1687                         -font font_ui
1688                 lappend disable_on_lock \
1689                         [list $m entryconf [$m index last] -state]
1690         }
1691 }
1692
1693 proc all_tracking_branches {} {
1694         global tracking_branches
1695
1696         set all_trackings {}
1697         set cmd {}
1698         foreach name [array names tracking_branches] {
1699                 if {[regsub {/\*$} $name {} name]} {
1700                         lappend cmd $name
1701                 } else {
1702                         regsub ^refs/(heads|remotes)/ $name {} name
1703                         lappend all_trackings $name
1704                 }
1705         }
1706
1707         if {$cmd ne {}} {
1708                 set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
1709                 while {[gets $fd name] > 0} {
1710                         regsub ^refs/(heads|remotes)/ $name {} name
1711                         lappend all_trackings $name
1712                 }
1713                 close $fd
1714         }
1715
1716         return [lsort -unique $all_trackings]
1717 }
1718
1719 proc do_create_branch_action {w} {
1720         global all_heads null_sha1 repo_config
1721         global create_branch_checkout create_branch_revtype
1722         global create_branch_head create_branch_trackinghead
1723
1724         set newbranch [string trim [$w.desc.name_t get 0.0 end]]
1725         if {$newbranch eq {}
1726                 || $newbranch eq $repo_config(gui.newbranchtemplate)} {
1727                 tk_messageBox \
1728                         -icon error \
1729                         -type ok \
1730                         -title [wm title $w] \
1731                         -parent $w \
1732                         -message "Please supply a branch name."
1733                 focus $w.desc.name_t
1734                 return
1735         }
1736         if {![catch {exec git show-ref --verify -- "refs/heads/$newbranch"}]} {
1737                 tk_messageBox \
1738                         -icon error \
1739                         -type ok \
1740                         -title [wm title $w] \
1741                         -parent $w \
1742                         -message "Branch '$newbranch' already exists."
1743                 focus $w.desc.name_t
1744                 return
1745         }
1746         if {[catch {exec git check-ref-format "heads/$newbranch"}]} {
1747                 tk_messageBox \
1748                         -icon error \
1749                         -type ok \
1750                         -title [wm title $w] \
1751                         -parent $w \
1752                         -message "We do not like '$newbranch' as a branch name."
1753                 focus $w.desc.name_t
1754                 return
1755         }
1756
1757         set rev {}
1758         switch -- $create_branch_revtype {
1759         head {set rev $create_branch_head}
1760         tracking {set rev $create_branch_trackinghead}
1761         expression {set rev [string trim [$w.from.exp_t get 0.0 end]]}
1762         }
1763         if {[catch {set cmt [exec git rev-parse --verify "${rev}^0"]}]} {
1764                 tk_messageBox \
1765                         -icon error \
1766                         -type ok \
1767                         -title [wm title $w] \
1768                         -parent $w \
1769                         -message "Invalid starting revision: $rev"
1770                 return
1771         }
1772         set cmd [list git update-ref]
1773         lappend cmd -m
1774         lappend cmd "branch: Created from $rev"
1775         lappend cmd "refs/heads/$newbranch"
1776         lappend cmd $cmt
1777         lappend cmd $null_sha1
1778         if {[catch {eval exec $cmd} err]} {
1779                 tk_messageBox \
1780                         -icon error \
1781                         -type ok \
1782                         -title [wm title $w] \
1783                         -parent $w \
1784                         -message "Failed to create '$newbranch'.\n\n$err"
1785                 return
1786         }
1787
1788         lappend all_heads $newbranch
1789         set all_heads [lsort $all_heads]
1790         populate_branch_menu
1791         destroy $w
1792         if {$create_branch_checkout} {
1793                 switch_branch $newbranch
1794         }
1795 }
1796
1797 proc radio_selector {varname value args} {
1798         upvar #0 $varname var
1799         set var $value
1800 }
1801
1802 trace add variable create_branch_head write \
1803         [list radio_selector create_branch_revtype head]
1804 trace add variable create_branch_trackinghead write \
1805         [list radio_selector create_branch_revtype tracking]
1806
1807 trace add variable delete_branch_head write \
1808         [list radio_selector delete_branch_checktype head]
1809 trace add variable delete_branch_trackinghead write \
1810         [list radio_selector delete_branch_checktype tracking]
1811
1812 proc do_create_branch {} {
1813         global all_heads current_branch repo_config
1814         global create_branch_checkout create_branch_revtype
1815         global create_branch_head create_branch_trackinghead
1816
1817         set w .branch_editor
1818         toplevel $w
1819         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1820
1821         label $w.header -text {Create New Branch} \
1822                 -font font_uibold
1823         pack $w.header -side top -fill x
1824
1825         frame $w.buttons
1826         button $w.buttons.create -text Create \
1827                 -font font_ui \
1828                 -default active \
1829                 -command [list do_create_branch_action $w]
1830         pack $w.buttons.create -side right
1831         button $w.buttons.cancel -text {Cancel} \
1832                 -font font_ui \
1833                 -command [list destroy $w]
1834         pack $w.buttons.cancel -side right -padx 5
1835         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1836
1837         labelframe $w.desc \
1838                 -text {Branch Description} \
1839                 -font font_ui
1840         label $w.desc.name_l -text {Name:} -font font_ui
1841         text $w.desc.name_t \
1842                 -borderwidth 1 \
1843                 -relief sunken \
1844                 -height 1 \
1845                 -width 40 \
1846                 -font font_ui
1847         $w.desc.name_t insert 0.0 $repo_config(gui.newbranchtemplate)
1848         grid $w.desc.name_l $w.desc.name_t -stick we -padx {0 5}
1849         bind $w.desc.name_t <Shift-Key-Tab> {focus [tk_focusPrev %W];break}
1850         bind $w.desc.name_t <Key-Tab> {focus [tk_focusNext %W];break}
1851         bind $w.desc.name_t <Key-Return> "do_create_branch_action $w;break"
1852         bind $w.desc.name_t <Key> {
1853                 if {{%K} ne {BackSpace}
1854                         && {%K} ne {Tab}
1855                         && {%K} ne {Escape}
1856                         && {%K} ne {Return}} {
1857                         if {%k <= 32} break
1858                         if {[string first %A {~^:?*[}] >= 0} break
1859                 }
1860         }
1861         grid columnconfigure $w.desc 1 -weight 1
1862         pack $w.desc -anchor nw -fill x -pady 5 -padx 5
1863
1864         labelframe $w.from \
1865                 -text {Starting Revision} \
1866                 -font font_ui
1867         radiobutton $w.from.head_r \
1868                 -text {Local Branch:} \
1869                 -value head \
1870                 -variable create_branch_revtype \
1871                 -font font_ui
1872         eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
1873         grid $w.from.head_r $w.from.head_m -sticky w
1874         set all_trackings [all_tracking_branches]
1875         if {$all_trackings ne {}} {
1876                 set create_branch_trackinghead [lindex $all_trackings 0]
1877                 radiobutton $w.from.tracking_r \
1878                         -text {Tracking Branch:} \
1879                         -value tracking \
1880                         -variable create_branch_revtype \
1881                         -font font_ui
1882                 eval tk_optionMenu $w.from.tracking_m \
1883                         create_branch_trackinghead \
1884                         $all_trackings
1885                 grid $w.from.tracking_r $w.from.tracking_m -sticky w
1886         }
1887         radiobutton $w.from.exp_r \
1888                 -text {Revision Expression:} \
1889                 -value expression \
1890                 -variable create_branch_revtype \
1891                 -font font_ui
1892         text $w.from.exp_t \
1893                 -borderwidth 1 \
1894                 -relief sunken \
1895                 -height 1 \
1896                 -width 50 \
1897                 -font font_ui
1898         grid $w.from.exp_r $w.from.exp_t -stick we -padx {0 5}
1899         bind $w.from.exp_t <Shift-Key-Tab> {focus [tk_focusPrev %W];break}
1900         bind $w.from.exp_t <Key-Tab> {focus [tk_focusNext %W];break}
1901         bind $w.from.exp_t <Key-Return> "do_create_branch_action $w;break"
1902         bind $w.from.exp_t <Key-space> break
1903         bind $w.from.exp_t <Key> {set create_branch_revtype expression}
1904         grid columnconfigure $w.from 1 -weight 1
1905         pack $w.from -anchor nw -fill x -pady 5 -padx 5
1906
1907         labelframe $w.postActions \
1908                 -text {Post Creation Actions} \
1909                 -font font_ui
1910         checkbutton $w.postActions.checkout \
1911                 -text {Checkout after creation} \
1912                 -variable create_branch_checkout \
1913                 -font font_ui
1914         pack $w.postActions.checkout -anchor nw
1915         pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
1916
1917         set create_branch_checkout 1
1918         set create_branch_head $current_branch
1919         set create_branch_revtype head
1920
1921         bind $w <Visibility> "grab $w; focus $w.desc.name_t"
1922         bind $w <Key-Escape> "destroy $w"
1923         bind $w <Key-Return> "do_create_branch_action $w;break"
1924         wm title $w "[appname] ([reponame]): Create Branch"
1925         tkwait window $w
1926 }
1927
1928 proc do_delete_branch_action {w} {
1929         global all_heads
1930         global delete_branch_checktype delete_branch_head delete_branch_trackinghead
1931
1932         set check_rev {}
1933         switch -- $delete_branch_checktype {
1934         head {set check_rev $delete_branch_head}
1935         tracking {set check_rev $delete_branch_trackinghead}
1936         always {set check_rev {:none}}
1937         }
1938         if {$check_rev eq {:none}} {
1939                 set check_cmt {}
1940         } elseif {[catch {set check_cmt [exec git rev-parse --verify "${check_rev}^0"]}]} {
1941                 tk_messageBox \
1942                         -icon error \
1943                         -type ok \
1944                         -title [wm title $w] \
1945                         -parent $w \
1946                         -message "Invalid check revision: $check_rev"
1947                 return
1948         }
1949
1950         set to_delete [list]
1951         set not_merged [list]
1952         foreach i [$w.list.l curselection] {
1953                 set b [$w.list.l get $i]
1954                 if {[catch {set o [exec git rev-parse --verify $b]}]} continue
1955                 if {$check_cmt ne {}} {
1956                         if {$b eq $check_rev} continue
1957                         if {[catch {set m [exec git merge-base $o $check_cmt]}]} continue
1958                         if {$o ne $m} {
1959                                 lappend not_merged $b
1960                                 continue
1961                         }
1962                 }
1963                 lappend to_delete [list $b $o]
1964         }
1965         if {$not_merged ne {}} {
1966                 set msg "The following branches are not completely merged into $check_rev:
1967
1968  - [join $not_merged "\n - "]"
1969                 tk_messageBox \
1970                         -icon info \
1971                         -type ok \
1972                         -title [wm title $w] \
1973                         -parent $w \
1974                         -message $msg
1975         }
1976         if {$to_delete eq {}} return
1977         if {$delete_branch_checktype eq {always}} {
1978                 set msg {Recovering deleted branches is difficult.
1979
1980 Delete the selected branches?}
1981                 if {[tk_messageBox \
1982                         -icon warning \
1983                         -type yesno \
1984                         -title [wm title $w] \
1985                         -parent $w \
1986                         -message $msg] ne yes} {
1987                         return
1988                 }
1989         }
1990
1991         set failed {}
1992         foreach i $to_delete {
1993                 set b [lindex $i 0]
1994                 set o [lindex $i 1]
1995                 if {[catch {exec git update-ref -d "refs/heads/$b" $o} err]} {
1996                         append failed " - $b: $err\n"
1997                 } else {
1998                         set x [lsearch -sorted $all_heads $b]
1999                         if {$x >= 0} {
2000                                 set all_heads [lreplace $all_heads $x $x]
2001                         }
2002                 }
2003         }
2004
2005         if {$failed ne {}} {
2006                 tk_messageBox \
2007                         -icon error \
2008                         -type ok \
2009                         -title [wm title $w] \
2010                         -parent $w \
2011                         -message "Failed to delete branches:\n$failed"
2012         }
2013
2014         set all_heads [lsort $all_heads]
2015         populate_branch_menu
2016         destroy $w
2017 }
2018
2019 proc do_delete_branch {} {
2020         global all_heads tracking_branches current_branch
2021         global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2022
2023         set w .branch_editor
2024         toplevel $w
2025         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2026
2027         label $w.header -text {Delete Local Branch} \
2028                 -font font_uibold
2029         pack $w.header -side top -fill x
2030
2031         frame $w.buttons
2032         button $w.buttons.create -text Delete \
2033                 -font font_ui \
2034                 -command [list do_delete_branch_action $w]
2035         pack $w.buttons.create -side right
2036         button $w.buttons.cancel -text {Cancel} \
2037                 -font font_ui \
2038                 -command [list destroy $w]
2039         pack $w.buttons.cancel -side right -padx 5
2040         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2041
2042         labelframe $w.list \
2043                 -text {Local Branches} \
2044                 -font font_ui
2045         listbox $w.list.l \
2046                 -height 10 \
2047                 -width 50 \
2048                 -selectmode extended \
2049                 -font font_ui
2050         foreach h $all_heads {
2051                 if {$h ne $current_branch} {
2052                         $w.list.l insert end $h
2053                 }
2054         }
2055         pack $w.list.l -fill both -pady 5 -padx 5
2056         pack $w.list -fill both -pady 5 -padx 5
2057
2058         labelframe $w.validate \
2059                 -text {Delete Only If} \
2060                 -font font_ui
2061         radiobutton $w.validate.head_r \
2062                 -text {Merged Into Local Branch:} \
2063                 -value head \
2064                 -variable delete_branch_checktype \
2065                 -font font_ui
2066         eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
2067         grid $w.validate.head_r $w.validate.head_m -sticky w
2068         set all_trackings [all_tracking_branches]
2069         if {$all_trackings ne {}} {
2070                 set delete_branch_trackinghead [lindex $all_trackings 0]
2071                 radiobutton $w.validate.tracking_r \
2072                         -text {Merged Into Tracking Branch:} \
2073                         -value tracking \
2074                         -variable delete_branch_checktype \
2075                         -font font_ui
2076                 eval tk_optionMenu $w.validate.tracking_m \
2077                         delete_branch_trackinghead \
2078                         $all_trackings
2079                 grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
2080         }
2081         radiobutton $w.validate.always_r \
2082                 -text {Always (Do not perform merge checks)} \
2083                 -value always \
2084                 -variable delete_branch_checktype \
2085                 -font font_ui
2086         grid $w.validate.always_r -columnspan 2 -sticky w
2087         grid columnconfigure $w.validate 1 -weight 1
2088         pack $w.validate -anchor nw -fill x -pady 5 -padx 5
2089
2090         set delete_branch_head $current_branch
2091         set delete_branch_checktype head
2092
2093         bind $w <Visibility> "grab $w; focus $w"
2094         bind $w <Key-Escape> "destroy $w"
2095         wm title $w "[appname] ([reponame]): Delete Branch"
2096         tkwait window $w
2097 }
2098
2099 proc switch_branch {b} {
2100         global HEAD commit_type file_states current_branch
2101         global selected_commit_type ui_comm
2102
2103         if {![lock_index switch]} return
2104
2105         # -- Backup the selected branch (repository_state resets it)
2106         #
2107         set new_branch $current_branch
2108
2109         # -- Our in memory state should match the repository.
2110         #
2111         repository_state curType curHEAD curMERGE_HEAD
2112         if {[string match amend* $commit_type]
2113                 && $curType eq {normal}
2114                 && $curHEAD eq $HEAD} {
2115         } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
2116                 info_popup {Last scanned state does not match repository state.
2117
2118 Another Git program has modified this repository
2119 since the last scan.  A rescan must be performed
2120 before the current branch can be changed.
2121
2122 The rescan will be automatically started now.
2123 }
2124                 unlock_index
2125                 rescan {set ui_status_value {Ready.}}
2126                 return
2127         }
2128
2129         # -- Toss the message buffer if we are in amend mode.
2130         #
2131         if {[string match amend* $curType]} {
2132                 $ui_comm delete 0.0 end
2133                 $ui_comm edit reset
2134                 $ui_comm edit modified false
2135         }
2136
2137         set selected_commit_type new
2138         set current_branch $new_branch
2139
2140         unlock_index
2141         error "NOT FINISHED"
2142 }
2143
2144 ######################################################################
2145 ##
2146 ## remote management
2147
2148 proc load_all_remotes {} {
2149         global repo_config
2150         global all_remotes tracking_branches
2151
2152         set all_remotes [list]
2153         array unset tracking_branches
2154
2155         set rm_dir [gitdir remotes]
2156         if {[file isdirectory $rm_dir]} {
2157                 set all_remotes [glob \
2158                         -types f \
2159                         -tails \
2160                         -nocomplain \
2161                         -directory $rm_dir *]
2162
2163                 foreach name $all_remotes {
2164                         catch {
2165                                 set fd [open [file join $rm_dir $name] r]
2166                                 while {[gets $fd line] >= 0} {
2167                                         if {![regexp {^Pull:[   ]*([^:]+):(.+)$} \
2168                                                 $line line src dst]} continue
2169                                         if {![regexp ^refs/ $dst]} {
2170                                                 set dst "refs/heads/$dst"
2171                                         }
2172                                         set tracking_branches($dst) [list $name $src]
2173                                 }
2174                                 close $fd
2175                         }
2176                 }
2177         }
2178
2179         foreach line [array names repo_config remote.*.url] {
2180                 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
2181                 lappend all_remotes $name
2182
2183                 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
2184                         set fl {}
2185                 }
2186                 foreach line $fl {
2187                         if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
2188                         if {![regexp ^refs/ $dst]} {
2189                                 set dst "refs/heads/$dst"
2190                         }
2191                         set tracking_branches($dst) [list $name $src]
2192                 }
2193         }
2194
2195         set all_remotes [lsort -unique $all_remotes]
2196 }
2197
2198 proc populate_fetch_menu {m} {
2199         global all_remotes repo_config
2200
2201         foreach r $all_remotes {
2202                 set enable 0
2203                 if {![catch {set a $repo_config(remote.$r.url)}]} {
2204                         if {![catch {set a $repo_config(remote.$r.fetch)}]} {
2205                                 set enable 1
2206                         }
2207                 } else {
2208                         catch {
2209                                 set fd [open [gitdir remotes $r] r]
2210                                 while {[gets $fd n] >= 0} {
2211                                         if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
2212                                                 set enable 1
2213                                                 break
2214                                         }
2215                                 }
2216                                 close $fd
2217                         }
2218                 }
2219
2220                 if {$enable} {
2221                         $m add command \
2222                                 -label "Fetch from $r..." \
2223                                 -command [list fetch_from $r] \
2224                                 -font font_ui
2225                 }
2226         }
2227 }
2228
2229 proc populate_push_menu {m} {
2230         global all_remotes repo_config
2231
2232         foreach r $all_remotes {
2233                 set enable 0
2234                 if {![catch {set a $repo_config(remote.$r.url)}]} {
2235                         if {![catch {set a $repo_config(remote.$r.push)}]} {
2236                                 set enable 1
2237                         }
2238                 } else {
2239                         catch {
2240                                 set fd [open [gitdir remotes $r] r]
2241                                 while {[gets $fd n] >= 0} {
2242                                         if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
2243                                                 set enable 1
2244                                                 break
2245                                         }
2246                                 }
2247                                 close $fd
2248                         }
2249                 }
2250
2251                 if {$enable} {
2252                         $m add command \
2253                                 -label "Push to $r..." \
2254                                 -command [list push_to $r] \
2255                                 -font font_ui
2256                 }
2257         }
2258 }
2259
2260 proc populate_pull_menu {m} {
2261         global repo_config all_remotes disable_on_lock
2262
2263         foreach remote $all_remotes {
2264                 set rb_list [list]
2265                 if {[array get repo_config remote.$remote.url] ne {}} {
2266                         if {[array get repo_config remote.$remote.fetch] ne {}} {
2267                                 foreach line $repo_config(remote.$remote.fetch) {
2268                                         if {[regexp {^([^:]+):} $line line rb]} {
2269                                                 lappend rb_list $rb
2270                                         }
2271                                 }
2272                         }
2273                 } else {
2274                         catch {
2275                                 set fd [open [gitdir remotes $remote] r]
2276                                 while {[gets $fd line] >= 0} {
2277                                         if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
2278                                                 lappend rb_list $rb
2279                                         }
2280                                 }
2281                                 close $fd
2282                         }
2283                 }
2284
2285                 foreach rb $rb_list {
2286                         regsub ^refs/heads/ $rb {} rb_short
2287                         $m add command \
2288                                 -label "Branch $rb_short from $remote..." \
2289                                 -command [list pull_remote $remote $rb] \
2290                                 -font font_ui
2291                         lappend disable_on_lock \
2292                                 [list $m entryconf [$m index last] -state]
2293                 }
2294         }
2295 }
2296
2297 ######################################################################
2298 ##
2299 ## icons
2300
2301 set filemask {
2302 #define mask_width 14
2303 #define mask_height 15
2304 static unsigned char mask_bits[] = {
2305    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2306    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2307    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
2308 }
2309
2310 image create bitmap file_plain -background white -foreground black -data {
2311 #define plain_width 14
2312 #define plain_height 15
2313 static unsigned char plain_bits[] = {
2314    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2315    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
2316    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2317 } -maskdata $filemask
2318
2319 image create bitmap file_mod -background white -foreground blue -data {
2320 #define mod_width 14
2321 #define mod_height 15
2322 static unsigned char mod_bits[] = {
2323    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2324    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2325    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2326 } -maskdata $filemask
2327
2328 image create bitmap file_fulltick -background white -foreground "#007000" -data {
2329 #define file_fulltick_width 14
2330 #define file_fulltick_height 15
2331 static unsigned char file_fulltick_bits[] = {
2332    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
2333    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
2334    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2335 } -maskdata $filemask
2336
2337 image create bitmap file_parttick -background white -foreground "#005050" -data {
2338 #define parttick_width 14
2339 #define parttick_height 15
2340 static unsigned char parttick_bits[] = {
2341    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2342    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
2343    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2344 } -maskdata $filemask
2345
2346 image create bitmap file_question -background white -foreground black -data {
2347 #define file_question_width 14
2348 #define file_question_height 15
2349 static unsigned char file_question_bits[] = {
2350    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
2351    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
2352    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2353 } -maskdata $filemask
2354
2355 image create bitmap file_removed -background white -foreground red -data {
2356 #define file_removed_width 14
2357 #define file_removed_height 15
2358 static unsigned char file_removed_bits[] = {
2359    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2360    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
2361    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
2362 } -maskdata $filemask
2363
2364 image create bitmap file_merge -background white -foreground blue -data {
2365 #define file_merge_width 14
2366 #define file_merge_height 15
2367 static unsigned char file_merge_bits[] = {
2368    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
2369    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2370    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2371 } -maskdata $filemask
2372
2373 set ui_index .vpane.files.index.list
2374 set ui_workdir .vpane.files.workdir.list
2375
2376 set all_icons(_$ui_index)   file_plain
2377 set all_icons(A$ui_index)   file_fulltick
2378 set all_icons(M$ui_index)   file_fulltick
2379 set all_icons(D$ui_index)   file_removed
2380 set all_icons(U$ui_index)   file_merge
2381
2382 set all_icons(_$ui_workdir) file_plain
2383 set all_icons(M$ui_workdir) file_mod
2384 set all_icons(D$ui_workdir) file_question
2385 set all_icons(U$ui_workdir) file_merge
2386 set all_icons(O$ui_workdir) file_plain
2387
2388 set max_status_desc 0
2389 foreach i {
2390                 {__ "Unmodified"}
2391
2392                 {_M "Modified, not staged"}
2393                 {M_ "Staged for commit"}
2394                 {MM "Portions staged for commit"}
2395                 {MD "Staged for commit, missing"}
2396
2397                 {_O "Untracked, not staged"}
2398                 {A_ "Staged for commit"}
2399                 {AM "Portions staged for commit"}
2400                 {AD "Staged for commit, missing"}
2401
2402                 {_D "Missing"}
2403                 {D_ "Staged for removal"}
2404                 {DO "Staged for removal, still present"}
2405
2406                 {U_ "Requires merge resolution"}
2407                 {UU "Requires merge resolution"}
2408                 {UM "Requires merge resolution"}
2409                 {UD "Requires merge resolution"}
2410         } {
2411         if {$max_status_desc < [string length [lindex $i 1]]} {
2412                 set max_status_desc [string length [lindex $i 1]]
2413         }
2414         set all_descs([lindex $i 0]) [lindex $i 1]
2415 }
2416 unset i
2417
2418 ######################################################################
2419 ##
2420 ## util
2421
2422 proc is_MacOSX {} {
2423         global tcl_platform tk_library
2424         if {[tk windowingsystem] eq {aqua}} {
2425                 return 1
2426         }
2427         return 0
2428 }
2429
2430 proc is_Windows {} {
2431         global tcl_platform
2432         if {$tcl_platform(platform) eq {windows}} {
2433                 return 1
2434         }
2435         return 0
2436 }
2437
2438 proc bind_button3 {w cmd} {
2439         bind $w <Any-Button-3> $cmd
2440         if {[is_MacOSX]} {
2441                 bind $w <Control-Button-1> $cmd
2442         }
2443 }
2444
2445 proc incr_font_size {font {amt 1}} {
2446         set sz [font configure $font -size]
2447         incr sz $amt
2448         font configure $font -size $sz
2449         font configure ${font}bold -size $sz
2450 }
2451
2452 proc hook_failed_popup {hook msg} {
2453         set w .hookfail
2454         toplevel $w
2455
2456         frame $w.m
2457         label $w.m.l1 -text "$hook hook failed:" \
2458                 -anchor w \
2459                 -justify left \
2460                 -font font_uibold
2461         text $w.m.t \
2462                 -background white -borderwidth 1 \
2463                 -relief sunken \
2464                 -width 80 -height 10 \
2465                 -font font_diff \
2466                 -yscrollcommand [list $w.m.sby set]
2467         label $w.m.l2 \
2468                 -text {You must correct the above errors before committing.} \
2469                 -anchor w \
2470                 -justify left \
2471                 -font font_uibold
2472         scrollbar $w.m.sby -command [list $w.m.t yview]
2473         pack $w.m.l1 -side top -fill x
2474         pack $w.m.l2 -side bottom -fill x
2475         pack $w.m.sby -side right -fill y
2476         pack $w.m.t -side left -fill both -expand 1
2477         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2478
2479         $w.m.t insert 1.0 $msg
2480         $w.m.t conf -state disabled
2481
2482         button $w.ok -text OK \
2483                 -width 15 \
2484                 -font font_ui \
2485                 -command "destroy $w"
2486         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2487
2488         bind $w <Visibility> "grab $w; focus $w"
2489         bind $w <Key-Return> "destroy $w"
2490         wm title $w "[appname] ([reponame]): error"
2491         tkwait window $w
2492 }
2493
2494 set next_console_id 0
2495
2496 proc new_console {short_title long_title} {
2497         global next_console_id console_data
2498         set w .console[incr next_console_id]
2499         set console_data($w) [list $short_title $long_title]
2500         return [console_init $w]
2501 }
2502
2503 proc console_init {w} {
2504         global console_cr console_data M1B
2505
2506         set console_cr($w) 1.0
2507         toplevel $w
2508         frame $w.m
2509         label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
2510                 -anchor w \
2511                 -justify left \
2512                 -font font_uibold
2513         text $w.m.t \
2514                 -background white -borderwidth 1 \
2515                 -relief sunken \
2516                 -width 80 -height 10 \
2517                 -font font_diff \
2518                 -state disabled \
2519                 -yscrollcommand [list $w.m.sby set]
2520         label $w.m.s -text {Working... please wait...} \
2521                 -anchor w \
2522                 -justify left \
2523                 -font font_uibold
2524         scrollbar $w.m.sby -command [list $w.m.t yview]
2525         pack $w.m.l1 -side top -fill x
2526         pack $w.m.s -side bottom -fill x
2527         pack $w.m.sby -side right -fill y
2528         pack $w.m.t -side left -fill both -expand 1
2529         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2530
2531         menu $w.ctxm -tearoff 0
2532         $w.ctxm add command -label "Copy" \
2533                 -font font_ui \
2534                 -command "tk_textCopy $w.m.t"
2535         $w.ctxm add command -label "Select All" \
2536                 -font font_ui \
2537                 -command "$w.m.t tag add sel 0.0 end"
2538         $w.ctxm add command -label "Copy All" \
2539                 -font font_ui \
2540                 -command "
2541                         $w.m.t tag add sel 0.0 end
2542                         tk_textCopy $w.m.t
2543                         $w.m.t tag remove sel 0.0 end
2544                 "
2545
2546         button $w.ok -text {Close} \
2547                 -font font_ui \
2548                 -state disabled \
2549                 -command "destroy $w"
2550         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2551
2552         bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
2553         bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
2554         bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
2555         bind $w <Visibility> "focus $w"
2556         wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
2557         return $w
2558 }
2559
2560 proc console_exec {w cmd {after {}}} {
2561         # -- Windows tosses the enviroment when we exec our child.
2562         #    But most users need that so we have to relogin. :-(
2563         #
2564         if {[is_Windows]} {
2565                 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
2566         }
2567
2568         # -- Tcl won't let us redirect both stdout and stderr to
2569         #    the same pipe.  So pass it through cat...
2570         #
2571         set cmd [concat | $cmd |& cat]
2572
2573         set fd_f [open $cmd r]
2574         fconfigure $fd_f -blocking 0 -translation binary
2575         fileevent $fd_f readable [list console_read $w $fd_f $after]
2576 }
2577
2578 proc console_read {w fd after} {
2579         global console_cr console_data
2580
2581         set buf [read $fd]
2582         if {$buf ne {}} {
2583                 if {![winfo exists $w]} {console_init $w}
2584                 $w.m.t conf -state normal
2585                 set c 0
2586                 set n [string length $buf]
2587                 while {$c < $n} {
2588                         set cr [string first "\r" $buf $c]
2589                         set lf [string first "\n" $buf $c]
2590                         if {$cr < 0} {set cr [expr {$n + 1}]}
2591                         if {$lf < 0} {set lf [expr {$n + 1}]}
2592
2593                         if {$lf < $cr} {
2594                                 $w.m.t insert end [string range $buf $c $lf]
2595                                 set console_cr($w) [$w.m.t index {end -1c}]
2596                                 set c $lf
2597                                 incr c
2598                         } else {
2599                                 $w.m.t delete $console_cr($w) end
2600                                 $w.m.t insert end "\n"
2601                                 $w.m.t insert end [string range $buf $c $cr]
2602                                 set c $cr
2603                                 incr c
2604                         }
2605                 }
2606                 $w.m.t conf -state disabled
2607                 $w.m.t see end
2608         }
2609
2610         fconfigure $fd -blocking 1
2611         if {[eof $fd]} {
2612                 if {[catch {close $fd}]} {
2613                         if {![winfo exists $w]} {console_init $w}
2614                         $w.m.s conf -background red -text {Error: Command Failed}
2615                         $w.ok conf -state normal
2616                         set ok 0
2617                 } elseif {[winfo exists $w]} {
2618                         $w.m.s conf -background green -text {Success}
2619                         $w.ok conf -state normal
2620                         set ok 1
2621                 }
2622                 array unset console_cr $w
2623                 array unset console_data $w
2624                 if {$after ne {}} {
2625                         uplevel #0 $after $ok
2626                 }
2627                 return
2628         }
2629         fconfigure $fd -blocking 0
2630 }
2631
2632 ######################################################################
2633 ##
2634 ## ui commands
2635
2636 set starting_gitk_msg {Starting gitk... please wait...}
2637
2638 proc do_gitk {revs} {
2639         global ui_status_value starting_gitk_msg
2640
2641         set cmd gitk
2642         if {$revs ne {}} {
2643                 append cmd { }
2644                 append cmd $revs
2645         }
2646         if {[is_Windows]} {
2647                 set cmd "sh -c \"exec $cmd\""
2648         }
2649         append cmd { &}
2650
2651         if {[catch {eval exec $cmd} err]} {
2652                 error_popup "Failed to start gitk:\n\n$err"
2653         } else {
2654                 set ui_status_value $starting_gitk_msg
2655                 after 10000 {
2656                         if {$ui_status_value eq $starting_gitk_msg} {
2657                                 set ui_status_value {Ready.}
2658                         }
2659                 }
2660         }
2661 }
2662
2663 proc do_gc {} {
2664         set w [new_console {gc} {Compressing the object database}]
2665         console_exec $w {git gc}
2666 }
2667
2668 proc do_fsck_objects {} {
2669         set w [new_console {fsck-objects} \
2670                 {Verifying the object database with fsck-objects}]
2671         set cmd [list git fsck-objects]
2672         lappend cmd --full
2673         lappend cmd --cache
2674         lappend cmd --strict
2675         console_exec $w $cmd
2676 }
2677
2678 set is_quitting 0
2679
2680 proc do_quit {} {
2681         global ui_comm is_quitting repo_config commit_type
2682
2683         if {$is_quitting} return
2684         set is_quitting 1
2685
2686         # -- Stash our current commit buffer.
2687         #
2688         set save [gitdir GITGUI_MSG]
2689         set msg [string trim [$ui_comm get 0.0 end]]
2690         if {![string match amend* $commit_type]
2691                 && [$ui_comm edit modified]
2692                 && $msg ne {}} {
2693                 catch {
2694                         set fd [open $save w]
2695                         puts $fd [string trim [$ui_comm get 0.0 end]]
2696                         close $fd
2697                 }
2698         } else {
2699                 catch {file delete $save}
2700         }
2701
2702         # -- Stash our current window geometry into this repository.
2703         #
2704         set cfg_geometry [list]
2705         lappend cfg_geometry [wm geometry .]
2706         lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
2707         lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
2708         if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2709                 set rc_geometry {}
2710         }
2711         if {$cfg_geometry ne $rc_geometry} {
2712                 catch {exec git repo-config gui.geometry $cfg_geometry}
2713         }
2714
2715         destroy .
2716 }
2717
2718 proc do_rescan {} {
2719         rescan {set ui_status_value {Ready.}}
2720 }
2721
2722 proc unstage_helper {txt paths} {
2723         global file_states current_diff_path
2724
2725         if {![lock_index begin-update]} return
2726
2727         set pathList [list]
2728         set after {}
2729         foreach path $paths {
2730                 switch -glob -- [lindex $file_states($path) 0] {
2731                 A? -
2732                 M? -
2733                 D? {
2734                         lappend pathList $path
2735                         if {$path eq $current_diff_path} {
2736                                 set after {reshow_diff;}
2737                         }
2738                 }
2739                 }
2740         }
2741         if {$pathList eq {}} {
2742                 unlock_index
2743         } else {
2744                 update_indexinfo \
2745                         $txt \
2746                         $pathList \
2747                         [concat $after {set ui_status_value {Ready.}}]
2748         }
2749 }
2750
2751 proc do_unstage_selection {} {
2752         global current_diff_path selected_paths
2753
2754         if {[array size selected_paths] > 0} {
2755                 unstage_helper \
2756                         {Unstaging selected files from commit} \
2757                         [array names selected_paths]
2758         } elseif {$current_diff_path ne {}} {
2759                 unstage_helper \
2760                         "Unstaging [short_path $current_diff_path] from commit" \
2761                         [list $current_diff_path]
2762         }
2763 }
2764
2765 proc add_helper {txt paths} {
2766         global file_states current_diff_path
2767
2768         if {![lock_index begin-update]} return
2769
2770         set pathList [list]
2771         set after {}
2772         foreach path $paths {
2773                 switch -glob -- [lindex $file_states($path) 0] {
2774                 _O -
2775                 ?M -
2776                 ?D -
2777                 U? {
2778                         lappend pathList $path
2779                         if {$path eq $current_diff_path} {
2780                                 set after {reshow_diff;}
2781                         }
2782                 }
2783                 }
2784         }
2785         if {$pathList eq {}} {
2786                 unlock_index
2787         } else {
2788                 update_index \
2789                         $txt \
2790                         $pathList \
2791                         [concat $after {set ui_status_value {Ready to commit.}}]
2792         }
2793 }
2794
2795 proc do_add_selection {} {
2796         global current_diff_path selected_paths
2797
2798         if {[array size selected_paths] > 0} {
2799                 add_helper \
2800                         {Adding selected files} \
2801                         [array names selected_paths]
2802         } elseif {$current_diff_path ne {}} {
2803                 add_helper \
2804                         "Adding [short_path $current_diff_path]" \
2805                         [list $current_diff_path]
2806         }
2807 }
2808
2809 proc do_add_all {} {
2810         global file_states
2811
2812         set paths [list]
2813         foreach path [array names file_states] {
2814                 switch -glob -- [lindex $file_states($path) 0] {
2815                 U? {continue}
2816                 ?M -
2817                 ?D {lappend paths $path}
2818                 }
2819         }
2820         add_helper {Adding all changed files} $paths
2821 }
2822
2823 proc revert_helper {txt paths} {
2824         global file_states current_diff_path
2825
2826         if {![lock_index begin-update]} return
2827
2828         set pathList [list]
2829         set after {}
2830         foreach path $paths {
2831                 switch -glob -- [lindex $file_states($path) 0] {
2832                 U? {continue}
2833                 ?M -
2834                 ?D {
2835                         lappend pathList $path
2836                         if {$path eq $current_diff_path} {
2837                                 set after {reshow_diff;}
2838                         }
2839                 }
2840                 }
2841         }
2842
2843         set n [llength $pathList]
2844         if {$n == 0} {
2845                 unlock_index
2846                 return
2847         } elseif {$n == 1} {
2848                 set s "[short_path [lindex $pathList]]"
2849         } else {
2850                 set s "these $n files"
2851         }
2852
2853         set reply [tk_dialog \
2854                 .confirm_revert \
2855                 "[appname] ([reponame])" \
2856                 "Revert changes in $s?
2857
2858 Any unadded changes will be permanently lost by the revert." \
2859                 question \
2860                 1 \
2861                 {Do Nothing} \
2862                 {Revert Changes} \
2863                 ]
2864         if {$reply == 1} {
2865                 checkout_index \
2866                         $txt \
2867                         $pathList \
2868                         [concat $after {set ui_status_value {Ready.}}]
2869         } else {
2870                 unlock_index
2871         }
2872 }
2873
2874 proc do_revert_selection {} {
2875         global current_diff_path selected_paths
2876
2877         if {[array size selected_paths] > 0} {
2878                 revert_helper \
2879                         {Reverting selected files} \
2880                         [array names selected_paths]
2881         } elseif {$current_diff_path ne {}} {
2882                 revert_helper \
2883                         "Reverting [short_path $current_diff_path]" \
2884                         [list $current_diff_path]
2885         }
2886 }
2887
2888 proc do_signoff {} {
2889         global ui_comm
2890
2891         set me [committer_ident]
2892         if {$me eq {}} return
2893
2894         set sob "Signed-off-by: $me"
2895         set last [$ui_comm get {end -1c linestart} {end -1c}]
2896         if {$last ne $sob} {
2897                 $ui_comm edit separator
2898                 if {$last ne {}
2899                         && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
2900                         $ui_comm insert end "\n"
2901                 }
2902                 $ui_comm insert end "\n$sob"
2903                 $ui_comm edit separator
2904                 $ui_comm see end
2905         }
2906 }
2907
2908 proc do_select_commit_type {} {
2909         global commit_type selected_commit_type
2910
2911         if {$selected_commit_type eq {new}
2912                 && [string match amend* $commit_type]} {
2913                 create_new_commit
2914         } elseif {$selected_commit_type eq {amend}
2915                 && ![string match amend* $commit_type]} {
2916                 load_last_commit
2917
2918                 # The amend request was rejected...
2919                 #
2920                 if {![string match amend* $commit_type]} {
2921                         set selected_commit_type new
2922                 }
2923         }
2924 }
2925
2926 proc do_commit {} {
2927         commit_tree
2928 }
2929
2930 proc do_about {} {
2931         global appvers copyright
2932         global tcl_patchLevel tk_patchLevel
2933
2934         set w .about_dialog
2935         toplevel $w
2936         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2937
2938         label $w.header -text "About [appname]" \
2939                 -font font_uibold
2940         pack $w.header -side top -fill x
2941
2942         frame $w.buttons
2943         button $w.buttons.close -text {Close} \
2944                 -font font_ui \
2945                 -command [list destroy $w]
2946         pack $w.buttons.close -side right
2947         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2948
2949         label $w.desc \
2950                 -text "[appname] - a commit creation tool for Git.
2951 $copyright" \
2952                 -padx 5 -pady 5 \
2953                 -justify left \
2954                 -anchor w \
2955                 -borderwidth 1 \
2956                 -relief solid \
2957                 -font font_ui
2958         pack $w.desc -side top -fill x -padx 5 -pady 5
2959
2960         set v {}
2961         append v "[appname] version $appvers\n"
2962         append v "[exec git version]\n"
2963         append v "\n"
2964         if {$tcl_patchLevel eq $tk_patchLevel} {
2965                 append v "Tcl/Tk version $tcl_patchLevel"
2966         } else {
2967                 append v "Tcl version $tcl_patchLevel"
2968                 append v ", Tk version $tk_patchLevel"
2969         }
2970
2971         label $w.vers \
2972                 -text $v \
2973                 -padx 5 -pady 5 \
2974                 -justify left \
2975                 -anchor w \
2976                 -borderwidth 1 \
2977                 -relief solid \
2978                 -font font_ui
2979         pack $w.vers -side top -fill x -padx 5 -pady 5
2980
2981         menu $w.ctxm -tearoff 0
2982         $w.ctxm add command \
2983                 -label {Copy} \
2984                 -font font_ui \
2985                 -command "
2986                 clipboard clear
2987                 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
2988         "
2989
2990         bind $w <Visibility> "grab $w; focus $w"
2991         bind $w <Key-Escape> "destroy $w"
2992         bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
2993         wm title $w "About [appname]"
2994         tkwait window $w
2995 }
2996
2997 proc do_options {} {
2998         global repo_config global_config font_descs
2999         global repo_config_new global_config_new
3000
3001         array unset repo_config_new
3002         array unset global_config_new
3003         foreach name [array names repo_config] {
3004                 set repo_config_new($name) $repo_config($name)
3005         }
3006         load_config 1
3007         foreach name [array names repo_config] {
3008                 switch -- $name {
3009                 gui.diffcontext {continue}
3010                 }
3011                 set repo_config_new($name) $repo_config($name)
3012         }
3013         foreach name [array names global_config] {
3014                 set global_config_new($name) $global_config($name)
3015         }
3016
3017         set w .options_editor
3018         toplevel $w
3019         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
3020
3021         label $w.header -text "[appname] Options" \
3022                 -font font_uibold
3023         pack $w.header -side top -fill x
3024
3025         frame $w.buttons
3026         button $w.buttons.restore -text {Restore Defaults} \
3027                 -font font_ui \
3028                 -command do_restore_defaults
3029         pack $w.buttons.restore -side left
3030         button $w.buttons.save -text Save \
3031                 -font font_ui \
3032                 -command "
3033                         catch {eval \[bind \[focus -displayof $w\] <FocusOut>\]}
3034                         do_save_config $w
3035                 "
3036         pack $w.buttons.save -side right
3037         button $w.buttons.cancel -text {Cancel} \
3038                 -font font_ui \
3039                 -command [list destroy $w]
3040         pack $w.buttons.cancel -side right -padx 5
3041         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
3042
3043         labelframe $w.repo -text "[reponame] Repository" \
3044                 -font font_ui \
3045                 -relief raised -borderwidth 2
3046         labelframe $w.global -text {Global (All Repositories)} \
3047                 -font font_ui \
3048                 -relief raised -borderwidth 2
3049         pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
3050         pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
3051
3052         foreach option {
3053                 {b pullsummary {Show Pull Summary}}
3054                 {b trustmtime  {Trust File Modification Timestamps}}
3055                 {i diffcontext {Number of Diff Context Lines}}
3056                 {t newbranchtemplate {New Branch Name Template}}
3057                 } {
3058                 set type [lindex $option 0]
3059                 set name [lindex $option 1]
3060                 set text [lindex $option 2]
3061                 foreach f {repo global} {
3062                         switch $type {
3063                         b {
3064                                 checkbutton $w.$f.$name -text $text \
3065                                         -variable ${f}_config_new(gui.$name) \
3066                                         -onvalue true \
3067                                         -offvalue false \
3068                                         -font font_ui
3069                                 pack $w.$f.$name -side top -anchor w
3070                         }
3071                         i {
3072                                 frame $w.$f.$name
3073                                 label $w.$f.$name.l -text "$text:" -font font_ui
3074                                 pack $w.$f.$name.l -side left -anchor w -fill x
3075                                 spinbox $w.$f.$name.v \
3076                                         -textvariable ${f}_config_new(gui.$name) \
3077                                         -from 1 -to 99 -increment 1 \
3078                                         -width 3 \
3079                                         -font font_ui
3080                                 bind $w.$f.$name.v <FocusIn> {%W selection range 0 end}
3081                                 pack $w.$f.$name.v -side right -anchor e -padx 5
3082                                 pack $w.$f.$name -side top -anchor w -fill x
3083                         }
3084                         t {
3085                                 frame $w.$f.$name
3086                                 label $w.$f.$name.l -text "$text:" -font font_ui
3087                                 text $w.$f.$name.v \
3088                                         -borderwidth 1 \
3089                                         -relief sunken \
3090                                         -height 1 \
3091                                         -width 20 \
3092                                         -font font_ui
3093                                 $w.$f.$name.v insert 0.0 [set ${f}_config_new(gui.$name)]
3094                                 bind $w.$f.$name.v <Shift-Key-Tab> {focus [tk_focusPrev %W];break}
3095                                 bind $w.$f.$name.v <Key-Tab> {focus [tk_focusNext %W];break}
3096                                 bind $w.$f.$name.v <Key-Return> break
3097                                 bind $w.$f.$name.v <FocusIn> "$w.$f.$name.v tag add sel 0.0 end"
3098                                 bind $w.$f.$name.v <FocusOut> "
3099                                         set ${f}_config_new(gui.$name) \
3100                                         \[string trim \[$w.$f.$name.v get 0.0 end\]\]
3101                                 "
3102                                 pack $w.$f.$name.l -side left -anchor w
3103                                 pack $w.$f.$name.v -side left -anchor w \
3104                                         -fill x -expand 1 \
3105                                         -padx 5
3106                                 pack $w.$f.$name -side top -anchor w -fill x
3107                         }
3108                         }
3109                 }
3110         }
3111
3112         set all_fonts [lsort [font families]]
3113         foreach option $font_descs {
3114                 set name [lindex $option 0]
3115                 set font [lindex $option 1]
3116                 set text [lindex $option 2]
3117
3118                 set global_config_new(gui.$font^^family) \
3119                         [font configure $font -family]
3120                 set global_config_new(gui.$font^^size) \
3121                         [font configure $font -size]
3122
3123                 frame $w.global.$name
3124                 label $w.global.$name.l -text "$text:" -font font_ui
3125                 pack $w.global.$name.l -side left -anchor w -fill x
3126                 eval tk_optionMenu $w.global.$name.family \
3127                         global_config_new(gui.$font^^family) \
3128                         $all_fonts
3129                 spinbox $w.global.$name.size \
3130                         -textvariable global_config_new(gui.$font^^size) \
3131                         -from 2 -to 80 -increment 1 \
3132                         -width 3 \
3133                         -font font_ui
3134                 bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
3135                 pack $w.global.$name.size -side right -anchor e
3136                 pack $w.global.$name.family -side right -anchor e
3137                 pack $w.global.$name -side top -anchor w -fill x
3138         }
3139
3140         bind $w <Visibility> "grab $w; focus $w"
3141         bind $w <Key-Escape> "destroy $w"
3142         wm title $w "[appname] ([reponame]): Options"
3143         tkwait window $w
3144 }
3145
3146 proc do_restore_defaults {} {
3147         global font_descs default_config repo_config
3148         global repo_config_new global_config_new
3149
3150         foreach name [array names default_config] {
3151                 set repo_config_new($name) $default_config($name)
3152                 set global_config_new($name) $default_config($name)
3153         }
3154
3155         foreach option $font_descs {
3156                 set name [lindex $option 0]
3157                 set repo_config(gui.$name) $default_config(gui.$name)
3158         }
3159         apply_config
3160
3161         foreach option $font_descs {
3162                 set name [lindex $option 0]
3163                 set font [lindex $option 1]
3164                 set global_config_new(gui.$font^^family) \
3165                         [font configure $font -family]
3166                 set global_config_new(gui.$font^^size) \
3167                         [font configure $font -size]
3168         }
3169 }
3170
3171 proc do_save_config {w} {
3172         if {[catch {save_config} err]} {
3173                 error_popup "Failed to completely save options:\n\n$err"
3174         }
3175         reshow_diff
3176         destroy $w
3177 }
3178
3179 proc do_windows_shortcut {} {
3180         global argv0
3181
3182         if {[catch {
3183                 set desktop [exec cygpath \
3184                         --windows \
3185                         --absolute \
3186                         --long-name \
3187                         --desktop]
3188                 }]} {
3189                         set desktop .
3190         }
3191         set fn [tk_getSaveFile \
3192                 -parent . \
3193                 -title "[appname] ([reponame]): Create Desktop Icon" \
3194                 -initialdir $desktop \
3195                 -initialfile "Git [reponame].bat"]
3196         if {$fn != {}} {
3197                 if {[catch {
3198                                 set fd [open $fn w]
3199                                 set sh [exec cygpath \
3200                                         --windows \
3201                                         --absolute \
3202                                         /bin/sh]
3203                                 set me [exec cygpath \
3204                                         --unix \
3205                                         --absolute \
3206                                         $argv0]
3207                                 set gd [exec cygpath \
3208                                         --unix \
3209                                         --absolute \
3210                                         [gitdir]]
3211                                 set gw [exec cygpath \
3212                                         --windows \
3213                                         --absolute \
3214                                         [file dirname [gitdir]]]
3215                                 regsub -all ' $me "'\\''" me
3216                                 regsub -all ' $gd "'\\''" gd
3217                                 puts $fd "@ECHO Entering $gw"
3218                                 puts $fd "@ECHO Starting git-gui... please wait..."
3219                                 puts -nonewline $fd "@\"$sh\" --login -c \""
3220                                 puts -nonewline $fd "GIT_DIR='$gd'"
3221                                 puts -nonewline $fd " '$me'"
3222                                 puts $fd "&\""
3223                                 close $fd
3224                         } err]} {
3225                         error_popup "Cannot write script:\n\n$err"
3226                 }
3227         }
3228 }
3229
3230 proc do_macosx_app {} {
3231         global argv0 env
3232
3233         set fn [tk_getSaveFile \
3234                 -parent . \
3235                 -title "[appname] ([reponame]): Create Desktop Icon" \
3236                 -initialdir [file join $env(HOME) Desktop] \
3237                 -initialfile "Git [reponame].app"]
3238         if {$fn != {}} {
3239                 if {[catch {
3240                                 set Contents [file join $fn Contents]
3241                                 set MacOS [file join $Contents MacOS]
3242                                 set exe [file join $MacOS git-gui]
3243
3244                                 file mkdir $MacOS
3245
3246                                 set fd [open [file join $Contents Info.plist] w]
3247                                 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
3248 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
3249 <plist version="1.0">
3250 <dict>
3251         <key>CFBundleDevelopmentRegion</key>
3252         <string>English</string>
3253         <key>CFBundleExecutable</key>
3254         <string>git-gui</string>
3255         <key>CFBundleIdentifier</key>
3256         <string>org.spearce.git-gui</string>
3257         <key>CFBundleInfoDictionaryVersion</key>
3258         <string>6.0</string>
3259         <key>CFBundlePackageType</key>
3260         <string>APPL</string>
3261         <key>CFBundleSignature</key>
3262         <string>????</string>
3263         <key>CFBundleVersion</key>
3264         <string>1.0</string>
3265         <key>NSPrincipalClass</key>
3266         <string>NSApplication</string>
3267 </dict>
3268 </plist>}
3269                                 close $fd
3270
3271                                 set fd [open $exe w]
3272                                 set gd [file normalize [gitdir]]
3273                                 set ep [file normalize [exec git --exec-path]]
3274                                 regsub -all ' $gd "'\\''" gd
3275                                 regsub -all ' $ep "'\\''" ep
3276                                 puts $fd "#!/bin/sh"
3277                                 foreach name [array names env] {
3278                                         if {[string match GIT_* $name]} {
3279                                                 regsub -all ' $env($name) "'\\''" v
3280                                                 puts $fd "export $name='$v'"
3281                                         }
3282                                 }
3283                                 puts $fd "export PATH='$ep':\$PATH"
3284                                 puts $fd "export GIT_DIR='$gd'"
3285                                 puts $fd "exec [file normalize $argv0]"
3286                                 close $fd
3287
3288                                 file attributes $exe -permissions u+x,g+x,o+x
3289                         } err]} {
3290                         error_popup "Cannot write icon:\n\n$err"
3291                 }
3292         }
3293 }
3294
3295 proc toggle_or_diff {w x y} {
3296         global file_states file_lists current_diff_path ui_index ui_workdir
3297         global last_clicked selected_paths
3298
3299         set pos [split [$w index @$x,$y] .]
3300         set lno [lindex $pos 0]
3301         set col [lindex $pos 1]
3302         set path [lindex $file_lists($w) [expr {$lno - 1}]]
3303         if {$path eq {}} {
3304                 set last_clicked {}
3305                 return
3306         }
3307
3308         set last_clicked [list $w $lno]
3309         array unset selected_paths
3310         $ui_index tag remove in_sel 0.0 end
3311         $ui_workdir tag remove in_sel 0.0 end
3312
3313         if {$col == 0} {
3314                 if {$current_diff_path eq $path} {
3315                         set after {reshow_diff;}
3316                 } else {
3317                         set after {}
3318                 }
3319                 if {$w eq $ui_index} {
3320                         update_indexinfo \
3321                                 "Unstaging [short_path $path] from commit" \
3322                                 [list $path] \
3323                                 [concat $after {set ui_status_value {Ready.}}]
3324                 } elseif {$w eq $ui_workdir} {
3325                         update_index \
3326                                 "Adding [short_path $path]" \
3327                                 [list $path] \
3328                                 [concat $after {set ui_status_value {Ready.}}]
3329                 }
3330         } else {
3331                 show_diff $path $w $lno
3332         }
3333 }
3334
3335 proc add_one_to_selection {w x y} {
3336         global file_lists last_clicked selected_paths
3337
3338         set lno [lindex [split [$w index @$x,$y] .] 0]
3339         set path [lindex $file_lists($w) [expr {$lno - 1}]]
3340         if {$path eq {}} {
3341                 set last_clicked {}
3342                 return
3343         }
3344
3345         if {$last_clicked ne {}
3346                 && [lindex $last_clicked 0] ne $w} {
3347                 array unset selected_paths
3348                 [lindex $last_clicked 0] tag remove in_sel 0.0 end
3349         }
3350
3351         set last_clicked [list $w $lno]
3352         if {[catch {set in_sel $selected_paths($path)}]} {
3353                 set in_sel 0
3354         }
3355         if {$in_sel} {
3356                 unset selected_paths($path)
3357                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
3358         } else {
3359                 set selected_paths($path) 1
3360                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3361         }
3362 }
3363
3364 proc add_range_to_selection {w x y} {
3365         global file_lists last_clicked selected_paths
3366
3367         if {[lindex $last_clicked 0] ne $w} {
3368                 toggle_or_diff $w $x $y
3369                 return
3370         }
3371
3372         set lno [lindex [split [$w index @$x,$y] .] 0]
3373         set lc [lindex $last_clicked 1]
3374         if {$lc < $lno} {
3375                 set begin $lc
3376                 set end $lno
3377         } else {
3378                 set begin $lno
3379                 set end $lc
3380         }
3381
3382         foreach path [lrange $file_lists($w) \
3383                 [expr {$begin - 1}] \
3384                 [expr {$end - 1}]] {
3385                 set selected_paths($path) 1
3386         }
3387         $w tag add in_sel $begin.0 [expr {$end + 1}].0
3388 }
3389
3390 ######################################################################
3391 ##
3392 ## config defaults
3393
3394 set cursor_ptr arrow
3395 font create font_diff -family Courier -size 10
3396 font create font_ui
3397 catch {
3398         label .dummy
3399         eval font configure font_ui [font actual [.dummy cget -font]]
3400         destroy .dummy
3401 }
3402
3403 font create font_uibold
3404 font create font_diffbold
3405
3406 if {[is_Windows]} {
3407         set M1B Control
3408         set M1T Ctrl
3409 } elseif {[is_MacOSX]} {
3410         set M1B M1
3411         set M1T Cmd
3412 } else {
3413         set M1B M1
3414         set M1T M1
3415 }
3416
3417 proc apply_config {} {
3418         global repo_config font_descs
3419
3420         foreach option $font_descs {
3421                 set name [lindex $option 0]
3422                 set font [lindex $option 1]
3423                 if {[catch {
3424                         foreach {cn cv} $repo_config(gui.$name) {
3425                                 font configure $font $cn $cv
3426                         }
3427                         } err]} {
3428                         error_popup "Invalid font specified in gui.$name:\n\n$err"
3429                 }
3430                 foreach {cn cv} [font configure $font] {
3431                         font configure ${font}bold $cn $cv
3432                 }
3433                 font configure ${font}bold -weight bold
3434         }
3435 }
3436
3437 set default_config(gui.trustmtime) false
3438 set default_config(gui.pullsummary) true
3439 set default_config(gui.diffcontext) 5
3440 set default_config(gui.newbranchtemplate) {}
3441 set default_config(gui.fontui) [font configure font_ui]
3442 set default_config(gui.fontdiff) [font configure font_diff]
3443 set font_descs {
3444         {fontui   font_ui   {Main Font}}
3445         {fontdiff font_diff {Diff/Console Font}}
3446 }
3447 load_config 0
3448 apply_config
3449
3450 ######################################################################
3451 ##
3452 ## ui construction
3453
3454 # -- Menu Bar
3455 #
3456 menu .mbar -tearoff 0
3457 .mbar add cascade -label Repository -menu .mbar.repository
3458 .mbar add cascade -label Edit -menu .mbar.edit
3459 if {!$single_commit} {
3460         .mbar add cascade -label Branch -menu .mbar.branch
3461 }
3462 .mbar add cascade -label Commit -menu .mbar.commit
3463 if {!$single_commit} {
3464         .mbar add cascade -label Fetch -menu .mbar.fetch
3465         .mbar add cascade -label Pull -menu .mbar.pull
3466         .mbar add cascade -label Push -menu .mbar.push
3467 }
3468 . configure -menu .mbar
3469
3470 # -- Repository Menu
3471 #
3472 menu .mbar.repository
3473 .mbar.repository add command \
3474         -label {Visualize Current Branch} \
3475         -command {do_gitk {}} \
3476         -font font_ui
3477 if {![is_MacOSX]} {
3478         .mbar.repository add command \
3479                 -label {Visualize All Branches} \
3480                 -command {do_gitk {--all}} \
3481                 -font font_ui
3482 }
3483 .mbar.repository add separator
3484
3485 if {!$single_commit} {
3486         .mbar.repository add command -label {Compress Database} \
3487                 -command do_gc \
3488                 -font font_ui
3489
3490         .mbar.repository add command -label {Verify Database} \
3491                 -command do_fsck_objects \
3492                 -font font_ui
3493
3494         .mbar.repository add separator
3495
3496         if {[is_Windows]} {
3497                 .mbar.repository add command \
3498                         -label {Create Desktop Icon} \
3499                         -command do_windows_shortcut \
3500                         -font font_ui
3501         } elseif {[is_MacOSX]} {
3502                 .mbar.repository add command \
3503                         -label {Create Desktop Icon} \
3504                         -command do_macosx_app \
3505                         -font font_ui
3506         }
3507 }
3508
3509 .mbar.repository add command -label Quit \
3510         -command do_quit \
3511         -accelerator $M1T-Q \
3512         -font font_ui
3513
3514 # -- Edit Menu
3515 #
3516 menu .mbar.edit
3517 .mbar.edit add command -label Undo \
3518         -command {catch {[focus] edit undo}} \
3519         -accelerator $M1T-Z \
3520         -font font_ui
3521 .mbar.edit add command -label Redo \
3522         -command {catch {[focus] edit redo}} \
3523         -accelerator $M1T-Y \
3524         -font font_ui
3525 .mbar.edit add separator
3526 .mbar.edit add command -label Cut \
3527         -command {catch {tk_textCut [focus]}} \
3528         -accelerator $M1T-X \
3529         -font font_ui
3530 .mbar.edit add command -label Copy \
3531         -command {catch {tk_textCopy [focus]}} \
3532         -accelerator $M1T-C \
3533         -font font_ui
3534 .mbar.edit add command -label Paste \
3535         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
3536         -accelerator $M1T-V \
3537         -font font_ui
3538 .mbar.edit add command -label Delete \
3539         -command {catch {[focus] delete sel.first sel.last}} \
3540         -accelerator Del \
3541         -font font_ui
3542 .mbar.edit add separator
3543 .mbar.edit add command -label {Select All} \
3544         -command {catch {[focus] tag add sel 0.0 end}} \
3545         -accelerator $M1T-A \
3546         -font font_ui
3547
3548 # -- Branch Menu
3549 #
3550 if {!$single_commit} {
3551         menu .mbar.branch
3552
3553         .mbar.branch add command -label {Create...} \
3554                 -command do_create_branch \
3555                 -accelerator $M1T-N \
3556                 -font font_ui
3557         lappend disable_on_lock [list .mbar.branch entryconf \
3558                 [.mbar.branch index last] -state]
3559
3560         .mbar.branch add command -label {Delete...} \
3561                 -command do_delete_branch \
3562                 -font font_ui
3563         lappend disable_on_lock [list .mbar.branch entryconf \
3564                 [.mbar.branch index last] -state]
3565 }
3566
3567 # -- Commit Menu
3568 #
3569 menu .mbar.commit
3570
3571 .mbar.commit add radiobutton \
3572         -label {New Commit} \
3573         -command do_select_commit_type \
3574         -variable selected_commit_type \
3575         -value new \
3576         -font font_ui
3577 lappend disable_on_lock \
3578         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3579
3580 .mbar.commit add radiobutton \
3581         -label {Amend Last Commit} \
3582         -command do_select_commit_type \
3583         -variable selected_commit_type \
3584         -value amend \
3585         -font font_ui
3586 lappend disable_on_lock \
3587         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3588
3589 .mbar.commit add separator
3590
3591 .mbar.commit add command -label Rescan \
3592         -command do_rescan \
3593         -accelerator F5 \
3594         -font font_ui
3595 lappend disable_on_lock \
3596         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3597
3598 .mbar.commit add command -label {Add To Commit} \
3599         -command do_add_selection \
3600         -font font_ui
3601 lappend disable_on_lock \
3602         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3603
3604 .mbar.commit add command -label {Add All To Commit} \
3605         -command do_add_all \
3606         -accelerator $M1T-I \
3607         -font font_ui
3608 lappend disable_on_lock \
3609         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3610
3611 .mbar.commit add command -label {Unstage From Commit} \
3612         -command do_unstage_selection \
3613         -font font_ui
3614 lappend disable_on_lock \
3615         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3616
3617 .mbar.commit add command -label {Revert Changes} \
3618         -command do_revert_selection \
3619         -font font_ui
3620 lappend disable_on_lock \
3621         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3622
3623 .mbar.commit add separator
3624
3625 .mbar.commit add command -label {Sign Off} \
3626         -command do_signoff \
3627         -accelerator $M1T-S \
3628         -font font_ui
3629
3630 .mbar.commit add command -label Commit \
3631         -command do_commit \
3632         -accelerator $M1T-Return \
3633         -font font_ui
3634 lappend disable_on_lock \
3635         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3636
3637 # -- Transport menus
3638 #
3639 if {!$single_commit} {
3640         menu .mbar.fetch
3641         menu .mbar.pull
3642         menu .mbar.push
3643 }
3644
3645 if {[is_MacOSX]} {
3646         # -- Apple Menu (Mac OS X only)
3647         #
3648         .mbar add cascade -label Apple -menu .mbar.apple
3649         menu .mbar.apple
3650
3651         .mbar.apple add command -label "About [appname]" \
3652                 -command do_about \
3653                 -font font_ui
3654         .mbar.apple add command -label "[appname] Options..." \
3655                 -command do_options \
3656                 -font font_ui
3657 } else {
3658         # -- Edit Menu
3659         #
3660         .mbar.edit add separator
3661         .mbar.edit add command -label {Options...} \
3662                 -command do_options \
3663                 -font font_ui
3664
3665         # -- Tools Menu
3666         #
3667         if {[file exists /usr/local/miga/lib/gui-miga]
3668                 && [file exists .pvcsrc]} {
3669         proc do_miga {} {
3670                 global ui_status_value
3671                 if {![lock_index update]} return
3672                 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
3673                 set miga_fd [open "|$cmd" r]
3674                 fconfigure $miga_fd -blocking 0
3675                 fileevent $miga_fd readable [list miga_done $miga_fd]
3676                 set ui_status_value {Running miga...}
3677         }
3678         proc miga_done {fd} {
3679                 read $fd 512
3680                 if {[eof $fd]} {
3681                         close $fd
3682                         unlock_index
3683                         rescan [list set ui_status_value {Ready.}]
3684                 }
3685         }
3686         .mbar add cascade -label Tools -menu .mbar.tools
3687         menu .mbar.tools
3688         .mbar.tools add command -label "Migrate" \
3689                 -command do_miga \
3690                 -font font_ui
3691         lappend disable_on_lock \
3692                 [list .mbar.tools entryconf [.mbar.tools index last] -state]
3693         }
3694
3695         # -- Help Menu
3696         #
3697         .mbar add cascade -label Help -menu .mbar.help
3698         menu .mbar.help
3699
3700         .mbar.help add command -label "About [appname]" \
3701                 -command do_about \
3702                 -font font_ui
3703 }
3704
3705
3706 # -- Branch Control
3707 #
3708 frame .branch \
3709         -borderwidth 1 \
3710         -relief sunken
3711 label .branch.l1 \
3712         -text {Current Branch:} \
3713         -anchor w \
3714         -justify left \
3715         -font font_ui
3716 label .branch.cb \
3717         -textvariable current_branch \
3718         -anchor w \
3719         -justify left \
3720         -font font_ui
3721 pack .branch.l1 -side left
3722 pack .branch.cb -side left -fill x
3723 pack .branch -side top -fill x
3724
3725 # -- Main Window Layout
3726 #
3727 panedwindow .vpane -orient vertical
3728 panedwindow .vpane.files -orient horizontal
3729 .vpane add .vpane.files -sticky nsew -height 100 -width 400
3730 pack .vpane -anchor n -side top -fill both -expand 1
3731
3732 # -- Index File List
3733 #
3734 frame .vpane.files.index -height 100 -width 400
3735 label .vpane.files.index.title -text {Changes To Be Committed} \
3736         -background green \
3737         -font font_ui
3738 text $ui_index -background white -borderwidth 0 \
3739         -width 40 -height 10 \
3740         -wrap none \
3741         -font font_ui \
3742         -cursor $cursor_ptr \
3743         -xscrollcommand {.vpane.files.index.sx set} \
3744         -yscrollcommand {.vpane.files.index.sy set} \
3745         -state disabled
3746 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
3747 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
3748 pack .vpane.files.index.title -side top -fill x
3749 pack .vpane.files.index.sx -side bottom -fill x
3750 pack .vpane.files.index.sy -side right -fill y
3751 pack $ui_index -side left -fill both -expand 1
3752 .vpane.files add .vpane.files.index -sticky nsew
3753
3754 # -- Working Directory File List
3755 #
3756 frame .vpane.files.workdir -height 100 -width 100
3757 label .vpane.files.workdir.title -text {Changed But Not Updated} \
3758         -background red \
3759         -font font_ui
3760 text $ui_workdir -background white -borderwidth 0 \
3761         -width 40 -height 10 \
3762         -wrap none \
3763         -font font_ui \
3764         -cursor $cursor_ptr \
3765         -xscrollcommand {.vpane.files.workdir.sx set} \
3766         -yscrollcommand {.vpane.files.workdir.sy set} \
3767         -state disabled
3768 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
3769 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3770 pack .vpane.files.workdir.title -side top -fill x
3771 pack .vpane.files.workdir.sx -side bottom -fill x
3772 pack .vpane.files.workdir.sy -side right -fill y
3773 pack $ui_workdir -side left -fill both -expand 1
3774 .vpane.files add .vpane.files.workdir -sticky nsew
3775
3776 foreach i [list $ui_index $ui_workdir] {
3777         $i tag conf in_diff -font font_uibold
3778         $i tag conf in_sel \
3779                 -background [$i cget -foreground] \
3780                 -foreground [$i cget -background]
3781 }
3782 unset i
3783
3784 # -- Diff and Commit Area
3785 #
3786 frame .vpane.lower -height 300 -width 400
3787 frame .vpane.lower.commarea
3788 frame .vpane.lower.diff -relief sunken -borderwidth 1
3789 pack .vpane.lower.commarea -side top -fill x
3790 pack .vpane.lower.diff -side bottom -fill both -expand 1
3791 .vpane add .vpane.lower -stick nsew
3792
3793 # -- Commit Area Buttons
3794 #
3795 frame .vpane.lower.commarea.buttons
3796 label .vpane.lower.commarea.buttons.l -text {} \
3797         -anchor w \
3798         -justify left \
3799         -font font_ui
3800 pack .vpane.lower.commarea.buttons.l -side top -fill x
3801 pack .vpane.lower.commarea.buttons -side left -fill y
3802
3803 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
3804         -command do_rescan \
3805         -font font_ui
3806 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3807 lappend disable_on_lock \
3808         {.vpane.lower.commarea.buttons.rescan conf -state}
3809
3810 button .vpane.lower.commarea.buttons.incall -text {Add All} \
3811         -command do_add_all \
3812         -font font_ui
3813 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3814 lappend disable_on_lock \
3815         {.vpane.lower.commarea.buttons.incall conf -state}
3816
3817 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
3818         -command do_signoff \
3819         -font font_ui
3820 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3821
3822 button .vpane.lower.commarea.buttons.commit -text {Commit} \
3823         -command do_commit \
3824         -font font_ui
3825 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3826 lappend disable_on_lock \
3827         {.vpane.lower.commarea.buttons.commit conf -state}
3828
3829 # -- Commit Message Buffer
3830 #
3831 frame .vpane.lower.commarea.buffer
3832 frame .vpane.lower.commarea.buffer.header
3833 set ui_comm .vpane.lower.commarea.buffer.t
3834 set ui_coml .vpane.lower.commarea.buffer.header.l
3835 radiobutton .vpane.lower.commarea.buffer.header.new \
3836         -text {New Commit} \
3837         -command do_select_commit_type \
3838         -variable selected_commit_type \
3839         -value new \
3840         -font font_ui
3841 lappend disable_on_lock \
3842         [list .vpane.lower.commarea.buffer.header.new conf -state]
3843 radiobutton .vpane.lower.commarea.buffer.header.amend \
3844         -text {Amend Last Commit} \
3845         -command do_select_commit_type \
3846         -variable selected_commit_type \
3847         -value amend \
3848         -font font_ui
3849 lappend disable_on_lock \
3850         [list .vpane.lower.commarea.buffer.header.amend conf -state]
3851 label $ui_coml \
3852         -anchor w \
3853         -justify left \
3854         -font font_ui
3855 proc trace_commit_type {varname args} {
3856         global ui_coml commit_type
3857         switch -glob -- $commit_type {
3858         initial       {set txt {Initial Commit Message:}}
3859         amend         {set txt {Amended Commit Message:}}
3860         amend-initial {set txt {Amended Initial Commit Message:}}
3861         amend-merge   {set txt {Amended Merge Commit Message:}}
3862         merge         {set txt {Merge Commit Message:}}
3863         *             {set txt {Commit Message:}}
3864         }
3865         $ui_coml conf -text $txt
3866 }
3867 trace add variable commit_type write trace_commit_type
3868 pack $ui_coml -side left -fill x
3869 pack .vpane.lower.commarea.buffer.header.amend -side right
3870 pack .vpane.lower.commarea.buffer.header.new -side right
3871
3872 text $ui_comm -background white -borderwidth 1 \
3873         -undo true \
3874         -maxundo 20 \
3875         -autoseparators true \
3876         -relief sunken \
3877         -width 75 -height 9 -wrap none \
3878         -font font_diff \
3879         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3880 scrollbar .vpane.lower.commarea.buffer.sby \
3881         -command [list $ui_comm yview]
3882 pack .vpane.lower.commarea.buffer.header -side top -fill x
3883 pack .vpane.lower.commarea.buffer.sby -side right -fill y
3884 pack $ui_comm -side left -fill y
3885 pack .vpane.lower.commarea.buffer -side left -fill y
3886
3887 # -- Commit Message Buffer Context Menu
3888 #
3889 set ctxm .vpane.lower.commarea.buffer.ctxm
3890 menu $ctxm -tearoff 0
3891 $ctxm add command \
3892         -label {Cut} \
3893         -font font_ui \
3894         -command {tk_textCut $ui_comm}
3895 $ctxm add command \
3896         -label {Copy} \
3897         -font font_ui \
3898         -command {tk_textCopy $ui_comm}
3899 $ctxm add command \
3900         -label {Paste} \
3901         -font font_ui \
3902         -command {tk_textPaste $ui_comm}
3903 $ctxm add command \
3904         -label {Delete} \
3905         -font font_ui \
3906         -command {$ui_comm delete sel.first sel.last}
3907 $ctxm add separator
3908 $ctxm add command \
3909         -label {Select All} \
3910         -font font_ui \
3911         -command {$ui_comm tag add sel 0.0 end}
3912 $ctxm add command \
3913         -label {Copy All} \
3914         -font font_ui \
3915         -command {
3916                 $ui_comm tag add sel 0.0 end
3917                 tk_textCopy $ui_comm
3918                 $ui_comm tag remove sel 0.0 end
3919         }
3920 $ctxm add separator
3921 $ctxm add command \
3922         -label {Sign Off} \
3923         -font font_ui \
3924         -command do_signoff
3925 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
3926
3927 # -- Diff Header
3928 #
3929 set current_diff_path {}
3930 set diff_actions [list]
3931 proc trace_current_diff_path {varname args} {
3932         global current_diff_path diff_actions file_states
3933         if {$current_diff_path eq {}} {
3934                 set s {}
3935                 set f {}
3936                 set p {}
3937                 set o disabled
3938         } else {
3939                 set p $current_diff_path
3940                 set s [mapdesc [lindex $file_states($p) 0] $p]
3941                 set f {File:}
3942                 set p [escape_path $p]
3943                 set o normal
3944         }
3945
3946         .vpane.lower.diff.header.status configure -text $s
3947         .vpane.lower.diff.header.file configure -text $f
3948         .vpane.lower.diff.header.path configure -text $p
3949         foreach w $diff_actions {
3950                 uplevel #0 $w $o
3951         }
3952 }
3953 trace add variable current_diff_path write trace_current_diff_path
3954
3955 frame .vpane.lower.diff.header -background orange
3956 label .vpane.lower.diff.header.status \
3957         -background orange \
3958         -width $max_status_desc \
3959         -anchor w \
3960         -justify left \
3961         -font font_ui
3962 label .vpane.lower.diff.header.file \
3963         -background orange \
3964         -anchor w \
3965         -justify left \
3966         -font font_ui
3967 label .vpane.lower.diff.header.path \
3968         -background orange \
3969         -anchor w \
3970         -justify left \
3971         -font font_ui
3972 pack .vpane.lower.diff.header.status -side left
3973 pack .vpane.lower.diff.header.file -side left
3974 pack .vpane.lower.diff.header.path -fill x
3975 set ctxm .vpane.lower.diff.header.ctxm
3976 menu $ctxm -tearoff 0
3977 $ctxm add command \
3978         -label {Copy} \
3979         -font font_ui \
3980         -command {
3981                 clipboard clear
3982                 clipboard append \
3983                         -format STRING \
3984                         -type STRING \
3985                         -- $current_diff_path
3986         }
3987 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3988 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3989
3990 # -- Diff Body
3991 #
3992 frame .vpane.lower.diff.body
3993 set ui_diff .vpane.lower.diff.body.t
3994 text $ui_diff -background white -borderwidth 0 \
3995         -width 80 -height 15 -wrap none \
3996         -font font_diff \
3997         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3998         -yscrollcommand {.vpane.lower.diff.body.sby set} \
3999         -state disabled
4000 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
4001         -command [list $ui_diff xview]
4002 scrollbar .vpane.lower.diff.body.sby -orient vertical \
4003         -command [list $ui_diff yview]
4004 pack .vpane.lower.diff.body.sbx -side bottom -fill x
4005 pack .vpane.lower.diff.body.sby -side right -fill y
4006 pack $ui_diff -side left -fill both -expand 1
4007 pack .vpane.lower.diff.header -side top -fill x
4008 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
4009
4010 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
4011 $ui_diff tag conf d_+ -foreground {#00a000}
4012 $ui_diff tag conf d_- -foreground red
4013
4014 $ui_diff tag conf d_++ -foreground {#00a000}
4015 $ui_diff tag conf d_-- -foreground red
4016 $ui_diff tag conf d_+s \
4017         -foreground {#00a000} \
4018         -background {#e2effa}
4019 $ui_diff tag conf d_-s \
4020         -foreground red \
4021         -background {#e2effa}
4022 $ui_diff tag conf d_s+ \
4023         -foreground {#00a000} \
4024         -background ivory1
4025 $ui_diff tag conf d_s- \
4026         -foreground red \
4027         -background ivory1
4028
4029 $ui_diff tag conf d<<<<<<< \
4030         -foreground orange \
4031         -font font_diffbold
4032 $ui_diff tag conf d======= \
4033         -foreground orange \
4034         -font font_diffbold
4035 $ui_diff tag conf d>>>>>>> \
4036         -foreground orange \
4037         -font font_diffbold
4038
4039 $ui_diff tag raise sel
4040
4041 # -- Diff Body Context Menu
4042 #
4043 set ctxm .vpane.lower.diff.body.ctxm
4044 menu $ctxm -tearoff 0
4045 $ctxm add command \
4046         -label {Refresh} \
4047         -font font_ui \
4048         -command reshow_diff
4049 $ctxm add command \
4050         -label {Copy} \
4051         -font font_ui \
4052         -command {tk_textCopy $ui_diff}
4053 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4054 $ctxm add command \
4055         -label {Select All} \
4056         -font font_ui \
4057         -command {$ui_diff tag add sel 0.0 end}
4058 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4059 $ctxm add command \
4060         -label {Copy All} \
4061         -font font_ui \
4062         -command {
4063                 $ui_diff tag add sel 0.0 end
4064                 tk_textCopy $ui_diff
4065                 $ui_diff tag remove sel 0.0 end
4066         }
4067 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4068 $ctxm add separator
4069 $ctxm add command \
4070         -label {Decrease Font Size} \
4071         -font font_ui \
4072         -command {incr_font_size font_diff -1}
4073 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4074 $ctxm add command \
4075         -label {Increase Font Size} \
4076         -font font_ui \
4077         -command {incr_font_size font_diff 1}
4078 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4079 $ctxm add separator
4080 $ctxm add command \
4081         -label {Show Less Context} \
4082         -font font_ui \
4083         -command {if {$repo_config(gui.diffcontext) >= 2} {
4084                 incr repo_config(gui.diffcontext) -1
4085                 reshow_diff
4086         }}
4087 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4088 $ctxm add command \
4089         -label {Show More Context} \
4090         -font font_ui \
4091         -command {
4092                 incr repo_config(gui.diffcontext)
4093                 reshow_diff
4094         }
4095 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4096 $ctxm add separator
4097 $ctxm add command -label {Options...} \
4098         -font font_ui \
4099         -command do_options
4100 bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
4101
4102 # -- Status Bar
4103 #
4104 set ui_status_value {Initializing...}
4105 label .status -textvariable ui_status_value \
4106         -anchor w \
4107         -justify left \
4108         -borderwidth 1 \
4109         -relief sunken \
4110         -font font_ui
4111 pack .status -anchor w -side bottom -fill x
4112
4113 # -- Load geometry
4114 #
4115 catch {
4116 set gm $repo_config(gui.geometry)
4117 wm geometry . [lindex $gm 0]
4118 .vpane sash place 0 \
4119         [lindex [.vpane sash coord 0] 0] \
4120         [lindex $gm 1]
4121 .vpane.files sash place 0 \
4122         [lindex $gm 2] \
4123         [lindex [.vpane.files sash coord 0] 1]
4124 unset gm
4125 }
4126
4127 # -- Key Bindings
4128 #
4129 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
4130 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
4131 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
4132 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
4133 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
4134 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
4135 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
4136 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
4137 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
4138 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4139 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4140
4141 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
4142 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
4143 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
4144 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
4145 bind $ui_diff <$M1B-Key-v> {break}
4146 bind $ui_diff <$M1B-Key-V> {break}
4147 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4148 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4149 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
4150 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
4151 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
4152 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
4153
4154 if {!$single_commit} {
4155         bind . <$M1B-Key-n> do_create_branch
4156         bind . <$M1B-Key-N> do_create_branch
4157 }
4158
4159 bind .   <Destroy> do_quit
4160 bind all <Key-F5> do_rescan
4161 bind all <$M1B-Key-r> do_rescan
4162 bind all <$M1B-Key-R> do_rescan
4163 bind .   <$M1B-Key-s> do_signoff
4164 bind .   <$M1B-Key-S> do_signoff
4165 bind .   <$M1B-Key-i> do_add_all
4166 bind .   <$M1B-Key-I> do_add_all
4167 bind .   <$M1B-Key-Return> do_commit
4168 bind all <$M1B-Key-q> do_quit
4169 bind all <$M1B-Key-Q> do_quit
4170 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
4171 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
4172 foreach i [list $ui_index $ui_workdir] {
4173         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
4174         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
4175         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
4176 }
4177 unset i
4178
4179 set file_lists($ui_index) [list]
4180 set file_lists($ui_workdir) [list]
4181
4182 set HEAD {}
4183 set PARENT {}
4184 set MERGE_HEAD [list]
4185 set commit_type {}
4186 set empty_tree {}
4187 set current_branch {}
4188 set current_diff_path {}
4189 set selected_commit_type new
4190
4191 wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
4192 focus -force $ui_comm
4193
4194 # -- Warn the user about environmental problems.  Cygwin's Tcl
4195 #    does *not* pass its env array onto any processes it spawns.
4196 #    This means that git processes get none of our environment.
4197 #
4198 if {[is_Windows]} {
4199         set ignored_env 0
4200         set suggest_user {}
4201         set msg "Possible environment issues exist.
4202
4203 The following environment variables are probably
4204 going to be ignored by any Git subprocess run
4205 by [appname]:
4206
4207 "
4208         foreach name [array names env] {
4209                 switch -regexp -- $name {
4210                 {^GIT_INDEX_FILE$} -
4211                 {^GIT_OBJECT_DIRECTORY$} -
4212                 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
4213                 {^GIT_DIFF_OPTS$} -
4214                 {^GIT_EXTERNAL_DIFF$} -
4215                 {^GIT_PAGER$} -
4216                 {^GIT_TRACE$} -
4217                 {^GIT_CONFIG$} -
4218                 {^GIT_CONFIG_LOCAL$} -
4219                 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
4220                         append msg " - $name\n"
4221                         incr ignored_env
4222                 }
4223                 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
4224                         append msg " - $name\n"
4225                         incr ignored_env
4226                         set suggest_user $name
4227                 }
4228                 }
4229         }
4230         if {$ignored_env > 0} {
4231                 append msg "
4232 This is due to a known issue with the
4233 Tcl binary distributed by Cygwin."
4234
4235                 if {$suggest_user ne {}} {
4236                         append msg "
4237
4238 A good replacement for $suggest_user
4239 is placing values for the user.name and
4240 user.email settings into your personal
4241 ~/.gitconfig file.
4242 "
4243                 }
4244                 warn_popup $msg
4245         }
4246         unset ignored_env msg suggest_user name
4247 }
4248
4249 # -- Only initialize complex UI if we are going to stay running.
4250 #
4251 if {!$single_commit} {
4252         load_all_remotes
4253         load_all_heads
4254
4255         populate_branch_menu
4256         populate_fetch_menu .mbar.fetch
4257         populate_pull_menu .mbar.pull
4258         populate_push_menu .mbar.push
4259 }
4260
4261 # -- Only suggest a gc run if we are going to stay running.
4262 #
4263 if {!$single_commit} {
4264         set object_limit 2000
4265         if {[is_Windows]} {set object_limit 200}
4266         regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
4267         if {$objects_current >= $object_limit} {
4268                 if {[ask_popup \
4269                         "This repository currently has $objects_current loose objects.
4270
4271 To maintain optimal performance it is strongly
4272 recommended that you compress the database
4273 when more than $object_limit loose objects exist.
4274
4275 Compress the database now?"] eq yes} {
4276                         do_gc
4277                 }
4278         }
4279         unset object_limit _junk objects_current
4280 }
4281
4282 lock_index begin-read
4283 after 1 do_rescan