git-gui.sh

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