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