git-gui

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