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