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