git-gui.sh

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